home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / rexx / imc / rexx-imc.5a / rxfn.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-09-02  |  75.9 KB  |  3,097 lines

  1. /* The builtin functions of REXX/imc         (C) Ian Collier 1992 */
  2.  
  3. #include"functions.h"
  4. #include"globals.h"
  5. #include<string.h>
  6. #include<time.h>
  7. #include<sys/ioctl.h>
  8. #include<sgtty.h>
  9. #include<sys/param.h>
  10. #include<malloc.h>
  11. #include<memory.h>
  12. #include<pwd.h>
  13. #include<search.h>
  14. #include<fcntl.h>
  15. #include<unistd.h>
  16. #include<errno.h>
  17. #include<sys/stat.h>
  18. #include<stdlib.h>
  19. #ifdef HAS_TTYCOM
  20. #include<sys/ttycom.h>
  21. #endif
  22. #define STDIN 0
  23. void rxsource();
  24. void rxerror();
  25. void rxlength();
  26. void rxtime();
  27. void rxdate();
  28. void rxleft();
  29. void rxright();
  30. void rxstrip();
  31. void rxvalue();
  32. void rxdatatype();
  33. void rxcopies();
  34. void rxspace();
  35. void rxrange();
  36. void c2x(),c2d(),b2x(),b2d(),d2c(),d2b(),d2x(),x2c(),x2d(),x2b();
  37. void xbyte();
  38. void rxsystem();
  39. void rxpos();
  40. void rxlastpos();
  41. void rxcentre();
  42. void rxjustify();
  43. void rxsubstr();
  44. void rxarg();
  45. void rxabbrev();
  46. void rxabs();
  47. void rxcompare();
  48. void rxdelstr();
  49. void rxdelword();
  50. void rxinsert();
  51. void rxmax();
  52. void rxmin();
  53. void rxoverlay();
  54. void rxrandom();
  55. void rxreverse();
  56. void rxsign();
  57. void rxsubword();
  58. void rxsymbol();
  59. void rxlate();
  60. void rxtrunc();
  61. void rxverify();
  62. void rxword();
  63. void rxwordindex();
  64. void rxwordlength();
  65. void rxwordpos();
  66. void rxwords();
  67. void rxdigits();
  68. void rxfuzz();
  69. void rxtrace();
  70. void rxform();
  71. void rxformat();
  72. void rxqueued();
  73. void rxlinesize();
  74. void rxbitand();
  75. void rxbitor();
  76. void rxbitxor();
  77. void rxuserid();
  78. void rxgetcwd();
  79. void rxchdir();
  80. void rxgetenv();
  81. void rxputenv();
  82. void rxopen();
  83. void rxlinein();
  84. void rxlineout();
  85. void rxcharin();
  86. void rxcharout();
  87. void rxchars();
  88. void rxlines();
  89. void rxchars2();
  90. void rxclose();
  91. void rxfileno();
  92. void rxfdopen();
  93. void rxpopen();
  94. void rxpclose();
  95. void rxftell();
  96. void rxstream();
  97. void rxaddress();
  98. void rxcondition();
  99.  
  100. int compar();
  101.  
  102. void binrel(); /* The calculator routine which implements binary relations */
  103.  
  104. struct fnlist {char *name;void (*fn)();};
  105.  
  106. int rxfn(name,argc)   /* does function if possible; returns 1 if successful */
  107.                       /* Returns -1 if the name was recognised as a math    */
  108.                       /* function, and 0 if the name was unrecognised.      */
  109. char *name;           /* Name of the function to call */
  110. int argc;             /* Number of arguments passed to it */
  111. {
  112.    static struct fnlist names[]={   /* The name and address of ever builtin */
  113.       "ABBREV",     rxabbrev,       /* function, in alphabetical order      */
  114.       "ABS",        rxabs,
  115.       "ADDRESS",    rxaddress,
  116.       "ARG",        rxarg,
  117.       "B2D",        b2d,
  118.       "B2X",        b2x,
  119.       "BITAND",     rxbitand,
  120.       "BITOR",      rxbitor,
  121.       "BITXOR",     rxbitxor,
  122.       "C2D",        c2d,
  123.       "C2X",        c2x,
  124.       "CENTER",     rxcentre,
  125.       "CENTRE",     rxcentre,
  126.       "CHARIN",     rxcharin,
  127.       "CHAROUT",    rxcharout,
  128.       "CHARS",      rxchars,
  129.       "CHDIR",      rxchdir,
  130.       "CLOSE",      rxclose,
  131.       "COMPARE",    rxcompare,
  132.       "CONDITION",  rxcondition,
  133.       "COPIES",     rxcopies,
  134.       "D2B",        d2b,
  135.       "D2C",        d2c,
  136.       "D2X",        d2x,
  137.       "DATATYPE",   rxdatatype,
  138.       "DATE",       rxdate,
  139.       "DELSTR",     rxdelstr,
  140.       "DELWORD",    rxdelword,
  141.       "DIGITS",     rxdigits,
  142.       "ERRORTEXT",  rxerror,
  143.       "FDOPEN",     rxfdopen,
  144.       "FILENO",     rxfileno,
  145.       "FORM",       rxform,
  146.       "FORMAT",     rxformat,
  147.       "FTELL",      rxftell,
  148.       "FUZZ",       rxfuzz,
  149.       "GETCWD",     rxgetcwd,
  150.       "GETENV",     rxgetenv,
  151.       "INSERT",     rxinsert,
  152.       "JUSTIFY",    rxjustify,
  153.       "LASTPOS",    rxlastpos,
  154.       "LEFT",       rxleft,
  155.       "LENGTH",     rxlength,
  156.       "LINEIN",     rxlinein,
  157.       "LINEOUT",    rxlineout,
  158.       "LINES",      rxlines,
  159.       "LINESIZE",   rxlinesize,
  160.       "MAX",        rxmax,
  161.       "MIN",        rxmin,
  162.       "OPEN",       rxopen,
  163.       "OVERLAY",    rxoverlay,
  164.       "PCLOSE",     rxpclose,
  165.       "POPEN",      rxpopen,
  166.       "POS",        rxpos,
  167.       "PUTENV",     rxputenv,
  168.       "QUEUED",     rxqueued,
  169.       "RANDOM",     rxrandom,
  170.       "REVERSE",    rxreverse,
  171.       "RIGHT",      rxright,
  172.       "SIGN",       rxsign,
  173.       "SOURCELINE", rxsource,
  174.       "SPACE",      rxspace,
  175.       "STREAM",     rxstream,
  176.       "STRIP",      rxstrip,
  177.       "SUBSTR",     rxsubstr,
  178.       "SUBWORD",    rxsubword,
  179.       "SYMBOL",     rxsymbol,
  180.       "SYSTEM",     rxsystem,
  181.       "TIME",       rxtime,
  182.       "TRACE",      rxtrace,
  183.       "TRANSLATE",  rxlate,
  184.       "TRUNC",      rxtrunc,
  185.       "USERID",     rxuserid,
  186.       "VALUE",      rxvalue,
  187.       "VERIFY",     rxverify,
  188.       "WORD",       rxword,
  189.       "WORDINDEX",  rxwordindex,
  190.       "WORDLENGTH", rxwordlength,
  191.       "WORDPOS",    rxwordpos,
  192.       "WORDS",      rxwords,
  193.       "X2B",        x2b,
  194.       "X2C",        x2c,
  195.       "X2D",        x2d,
  196.       "XRANGE",     rxrange
  197.       };
  198. #define nofun 0     /* "nofun" means "this function ain't here" */
  199.  
  200. /* The following structure names all the recognised mathematical functions;
  201.    if a function is found here then it is loaded from the external math
  202.    package. */
  203. static struct fnlist rxmathfn[]={"ACOS",nofun,"ASIN",nofun,"ATAN",nofun,
  204.            "COS",nofun,"EXP",nofun,"LN",nofun,"SIN",nofun,"SQRT",nofun,
  205.            "TAN",nofun,"TOPOWER",nofun};
  206.            
  207. #define numfun 84  /* The number of builtin functions */
  208. #define nummath 10 /* The number of math functions */
  209.  
  210.    struct fnlist test;
  211.    struct fnlist *ptr;
  212.    test.name=name; /* Initialise a structure with the candidate name */
  213.    ptr=(struct fnlist *) /* Search for a builtin function */
  214.       bsearch((char*)&test,(char*)names,numfun,sizeof(struct fnlist),compar);
  215.    if(!ptr){ /* If not found, search for a math function */
  216.       if(bsearch((char*)&test,(char*)rxmathfn,nummath,sizeof(struct fnlist),compar))
  217.          return -1; /* math function recognised */
  218.       return 0;     /* no function recognised */
  219.    }
  220.    (*(ptr->fn))(argc);  /* Call the builtin function */
  221.    return 1;            /* Done. */
  222. }
  223.  
  224. int compar(s1,s2) /* Compares two items of a function list, */
  225. char *s1,*s2;     /* as required by bsearch()               */
  226. {
  227.    return strcmp(((struct fnlist*)s1)->name,((struct fnlist *)s2)->name);
  228. }
  229.  
  230. char *undelete(l) /* A utility function like delete(l) except that */
  231. int *l;           /* the value isn't deleted from the stack */
  232. {
  233.    char *ptr=cstackptr+ecstackptr-four;
  234.    (*l)= *(int *)ptr;
  235.    if(*l>=0)ptr-=align(*l);
  236.    else ptr=(char *)-1;/* I don't think this is ever used */
  237.    return ptr;
  238. }
  239.  
  240. /* The rest of this file contains the builtin functions listed in the
  241.    dictionary above.  In general, each function ABC() is implemented by
  242.    the C routine rxabc().  Each routine takes one parameter - namely
  243.    the number of arguments passed to the builtin function - and gives no
  244.    return value.  The arguments and result of the builtin function are
  245.    passed on the calculator stack.  A null argument (as in abc(x,,y))
  246.    is represented by a stacked value having length -1. */
  247.  
  248. void rxsource(argc) /* souceline() function */
  249. int argc;
  250. {
  251.    int i;
  252.    char *s;
  253.    if(!argc){
  254.       stackint(lines); /* the number of source lines */
  255.       return;
  256.    }
  257.    if(argc!=1)die(Ecall);
  258.    if((i=getint(1))>lines||i<1)die(Erange);
  259.    s=source[i];
  260.    stack(s,strlen(s)); /* the ith source line */
  261. }
  262.  
  263. void rxerror(argc)  /* errortext() function */
  264. int argc;
  265. {
  266.    char *msg;
  267.    if(argc!=1)die(Ecall);
  268.    msg=message(getint(1));
  269.    stack(msg,strlen(msg));
  270. }
  271. void rxlength(argc)
  272. int argc;
  273. {
  274.    int l;
  275.    if(argc!=1)die(Ecall);
  276.    delete(&l);
  277.    stackint(l);
  278. }
  279. void rxtime(argc)
  280. int argc;
  281. {
  282.    struct tm *t2;
  283.    struct timezone tz;
  284.    char ans[20];
  285.    char opt='N';
  286.    char *arg;
  287.    long e1;
  288.    long e2;
  289.    int l;
  290.    if(!(timeflag&2))
  291.       gettimeofday(×tamp,&tz);/* Make a timestamp if necessary */
  292.    timeflag|=2;
  293.    t2=localtime(×tamp.tv_sec);/* t2 now contains all the necessary info */
  294.    if(argc>1)die(Ecall);
  295.    if(argc==1){
  296.       arg=delete(&l);
  297.       if(!l)die(Ecall);
  298.       opt=arg[0]&0xdf;
  299.    }
  300.    switch(opt){
  301.       case 'C':l=t2->tm_hour%12;
  302.          if(l==0)l=12;
  303.          sprintf(ans,"%d:%02d%s",l,t2->tm_min,(t2->tm_hour <12)?"am":"pm");
  304.          break;
  305.       case 'N':sprintf(ans,"%02d:%02d:%02d",t2->tm_hour,t2->tm_min,t2->tm_sec);
  306.          break;
  307.       case 'L':sprintf(ans,"%02d:%02d:%02d.%06d",t2->tm_hour,t2->tm_min,
  308.                        t2->tm_sec,timestamp.tv_usec);
  309.          break;
  310.       case 'H':sprintf(ans,"%d",t2->tm_hour);
  311.          break;
  312.       case 'M':sprintf(ans,"%d",(t2->tm_hour)*60+(t2->tm_min));
  313.          break;
  314.       case 'S':sprintf(ans,"%d",((t2->tm_hour)*60+(t2->tm_min))*60+(t2->tm_sec));
  315.          break;
  316.       case 'E':
  317.       case 'R':if(!(timeflag&1))secs=timestamp.tv_sec,
  318.                                 microsecs=timestamp.tv_usec;
  319.          timeflag|=1,
  320.          e2=timestamp.tv_usec-microsecs,
  321.          e1=timestamp.tv_sec-secs;
  322.          if(e2<0)e2+=1000000,e1--;
  323.          if(opt=='R')secs=timestamp.tv_sec,microsecs=timestamp.tv_usec;
  324.          if(e1||e2)sprintf(ans,"%ld.%06d",e1,e2);
  325.          else ans[0]='0',ans[1]=0; /* "0", not "0.000000" */
  326.          break;
  327.       default:die(Ecall);
  328.    }
  329.    stack(ans,strlen(ans));
  330. }
  331.  
  332. char *month[12]={"Jan","Feb","Mar","Apr","May","Jun","Jul",
  333.                  "Aug","Sep","Oct","Nov","Dec"};
  334. /* month names originally for rxdate() but needed for the Rexx version string*/
  335.  
  336. void rxdate(argc)
  337. int argc;
  338. {
  339.    static char *wkday[7]={"Sunday","Monday","Tuesday","Wednesday",
  340.                           "Thursday","Friday","Saturday"};
  341.    static char *fullmonth[12]={"January","February","March","April","May",
  342.                           "June","July","August","September","October",
  343.                           "November","December"};
  344.    struct timezone tz;   
  345.    struct tm *t2;
  346.    char ans[20];
  347.    char opt='N';
  348.    char *arg;
  349.    int l;
  350.    if(!(timeflag&2))
  351.       gettimeofday(×tamp,&tz);/* Make a timestamp if necessary */
  352.    timeflag|=2;
  353.    t2=localtime(×tamp.tv_sec);/* t2 now contains all the necessary info */
  354.    if(argc>1)die(Ecall);
  355.    if(argc==1){
  356.       arg=delete(&l);
  357.       if(!l)die(Ecall);
  358.       opt=arg[0]&0xdf;
  359.    }
  360.    switch(opt){
  361.       case 'B':sprintf(ans,"%ld",timestamp.tv_sec/86400+719162L);
  362.          break;
  363.       case 'C':sprintf(ans,"%ld",timestamp.tv_sec/86400+25568L);
  364.          break;
  365.       case 'D':sprintf(ans,"%d",t2 -> tm_yday+1);
  366.          break;
  367.       case 'E':sprintf(ans,"%02d/%02d/%02d",t2 ->tm_mday,t2->tm_mon+1,t2->tm_year);
  368.          break;
  369.       case 'J':sprintf(ans,"%02d%03d",t2->tm_year,t2->tm_yday+1);
  370.          break;
  371.       case 'M':strcpy(ans,fullmonth[t2->tm_mon]);
  372.          break;
  373.       case 'N':sprintf(ans,"%d %s %d",t2->tm_mday,month[t2->tm_mon],t2->tm_year+1900);
  374.          break;
  375.       case 'O':sprintf(ans,"%02d/%02d/%02d",t2->tm_year,t2->tm_mon+1,t2->tm_mday);
  376.          break;
  377.       case 'S':sprintf(ans,"%04d%02d%02d",t2->tm_year+1900,t2->tm_mon+1,t2->tm_mday);
  378.          break;
  379.       case 'U':sprintf(ans,"%02d/%02d/%02d",t2->tm_mon+1,t2->tm_mday,t2->tm_year);
  380.          break;
  381.       case 'W':strcpy(ans,wkday[t2->tm_wday]);
  382.          break;
  383.       default:die(Ecall);
  384.    }
  385.    stack(ans,strlen(ans));
  386. }
  387. void rxstrip(argc)
  388. int argc;
  389. {
  390.    char *arg;
  391.    int len;
  392.    char strip=' ';
  393.    int flg=0;
  394.    if(argc>3||!argc)die(Ecall);
  395.    if(argc==3){
  396.       arg=delete(&len);
  397.       if(len>1||len==0)die(Ecall);
  398.       else if(len==1)strip=arg[0];
  399.    }
  400.    if(argc>1){
  401.       arg=delete(&len);
  402.       if(!len)die(Ecall);
  403.       else if(len>0)switch(arg[0]&0xdf){
  404.       case 'T':flg=1;
  405.          break;
  406.       case 'L':flg= -1;
  407.       case 'B':break;
  408.       default:die(Ecall);
  409.       }
  410.    }
  411.    arg=delete(&len);
  412.    if(len<0)die(Enoarg);
  413.    if(flg<=0)for(;arg[0]==strip&&len;arg++,len--); /* strip leading chars */
  414.    if(flg>=0){while(len--&&arg[len]==strip);len++;}/* strip trailing chars */
  415.    mtest(workptr,worklen,len+5,len+5); /* move to worksp before stacking, */
  416.    memcpy(workptr,arg,len);            /* as stack() will destroy this copy */
  417.    stack(workptr,len);
  418. }
  419. void rxleft(argc)
  420. int argc;
  421. {
  422.    char *arg;
  423.    int len;
  424.    int len1;
  425.    char pad=' ';
  426.    int num;
  427.    if(argc>3||argc<2)die(Ecall);
  428.    if(argc==3){
  429.       arg=delete(&len);
  430.       if(len>=0){
  431.          if(len!=1)die(Ecall);
  432.          pad=arg[0];
  433.       }
  434.    }
  435.    if((num=getint(1))<0)die(Ecall);
  436.    arg=delete(&len);
  437.    if(len<0)die(Enoarg);
  438.    len1=len>num?len:num;
  439.    mtest(workptr,worklen,len1+5,len1+5);
  440.    len1=len<num?len:num;
  441.    memcpy(workptr,arg,len1);
  442.    for(;len1<num;workptr[len1++]=pad);
  443.    stack(workptr,num);
  444. }
  445. void rxright(argc)
  446. int argc;
  447. {
  448.    char *arg;
  449.    int len;
  450.    int len1;
  451.    int i;
  452.    char pad=' ';
  453.    int num;
  454.    if(argc>3||argc<2)die(Ecall);
  455.    if(argc==3){
  456.       arg=delete(&len);
  457.       if(len>0){
  458.          if(len!=1)die(Ecall);
  459.          pad=arg[0];
  460.       }
  461.    }
  462.    if((num=getint(1))<0)die(Ecall);
  463.    arg=delete(&len);
  464.    if(len<0)die(Enoarg);
  465.    len1=len>num?len:num;
  466.    mtest(workptr,worklen,len1+5,len1+5);
  467.    for(i=0;len+i<num;workptr[i++]=pad);
  468.    len1=len<num?len:num;
  469.    memcpy(workptr+i,arg+len-len1,len1);
  470.    stack(workptr,num);
  471. }
  472.  
  473. char *rxgetname(nl,t) /* get a symbol (if compound symbol, substitute values
  474.                          in tail). Afterwards, t=1 if valid, t=0 otherwise. */
  475. int *nl,*t;           /* Return value is the name, nl is the length.  The   */
  476. {                     /* result may contain garbage if the symbol was bad.  */
  477.    static char name[maxvarname];
  478.    int len,l;
  479.    char *arg=delete(&len);
  480.    char *val;
  481.    int p;
  482.    int i=0;
  483.    char c;
  484.    int dot=0;
  485.    int constsym=rexxsymbol(arg[0])<=0; /* whether it is a constant symbol */
  486.    (*t)=1;
  487.    if(len>=maxvarname-1)return *t=0,name;
  488.    while(len&&arg[0]!='.') {        /* Get the stem part */
  489.       name[i++]=c=uc((arg++)[0]),
  490.       len--;
  491.       if(!rexxsymbol(c))return *t=0,name;
  492.    }
  493.    if(len==1&&arg[0]=='.')dot=1,len--; /* Delete final dot of a stem */
  494.    while(len&&arg[0]=='.'){         /* Get each element of the tail */
  495.       dot=1;
  496.       name[p= i++]='.',
  497.       ++p,
  498.       ++arg,
  499.       len--;
  500.       while(len&&arg[0]!='.'){      /* copy the element */
  501.          c=name[i++]=uc((arg++)[0]),len--;
  502.          if(!rexxsymbol(c))return *t=0,name;
  503.       }
  504.       if(p!=i&&!constsym){          /* substitute it */
  505.          name[i]=0;
  506.          if(val=varget(name+p,i-p,&l)){
  507.             if(len+l>=maxvarname-1)return *t=0,name;
  508.             memcpy(name+p,val,l),i=p+l;
  509.          }
  510.       }
  511.    }
  512.    (*nl)=i;
  513.    name[i]=0;
  514.    if(dot&&!constsym)name[0]|=128; /* Compound symbols have the MSB set */
  515.    return name;
  516. }
  517.       
  518. void rxvalue(argc)
  519. int argc;
  520. {
  521.    char *arg;
  522.    char *val;
  523.    char *pool=0;
  524.    char **entry;
  525.    int poollen;
  526.    char *new=0;
  527.    int newlen;
  528.    int l,len,t;
  529.    int oldlen;
  530.    int path;
  531.    if(argc==3){
  532.       pool=delete(&poollen);
  533.       argc--;
  534.       pool[poollen]=0;
  535.    }
  536.    if(argc==2){
  537.       new=delete(&newlen);
  538.       argc--;
  539.       if(newlen<0)new=0;
  540.    }
  541.    if(argc!=1)die(Ecall);
  542.    arg=rxgetname(&len,&t); /* Get the symbol name, then try to get its value */
  543.    if(pool)                /* The pool name determines what we do here */
  544.       if(!strcasecmp(pool,"ENVIRONMENT")){
  545.          if(memchr(arg,0,len))die(Ecall);
  546.          arg[len]=0;
  547.          if(val=getenv(arg))stack(val,strlen(val));
  548.          else stack(cnull,0);
  549.          if(!new)return;
  550.          if(memchr(new,0,newlen))die(Ecall);
  551.          path=strcmp(arg,"PATH");
  552.          entry=(char**)hashfind(0,arg,&l);
  553.          arg[len]='=';
  554.          arg[len+1]=0;
  555.          putenv(arg); /* release the previous copy from the environment */
  556.          if(!l)*entry=allocm(len+newlen+2);
  557.          else if(strlen(*entry)<len+newlen+2)
  558.             if(!(*entry=realloc(*entry,len+newlen+2)))die(Emem);
  559.          memcpy(*entry,arg,++len);
  560.          memcpy(*entry+len,new,newlen);
  561.          entry[0][len+newlen]=0;
  562.          putenv(*entry);
  563.          if(!path)hashclear(); /* clear shell's hash table on change of PATH */
  564.          return;
  565.       }
  566.       /* here add more "else if"s */
  567.       else if(strcasecmp(pool,"REXX"))die(Ecall);
  568.    if(t&&(val=varget(arg,len,&l)))stack(val,l);
  569.    else if(t!=1)die(Ecall);/* die if it was bad */
  570.    else { /* stack the variable's name */
  571.       oldlen=len;
  572.       if((l=arg[0]&128)&&!memchr(arg,'.',len))arg[len++]='.';
  573.       arg[0]&=127,stack(arg,len);
  574.       arg[0]|=l;
  575.       len=oldlen;
  576.    }
  577.    if(new)varset(arg,len,new,newlen);
  578. }
  579.  
  580. void rxdatatype(argc)
  581. int argc;
  582. {
  583.    char *arg;
  584.    int len;
  585.    int i,numb=1,fst=1;
  586.    int m,e,z,l;
  587.    char c;
  588.    if(argc>2||!argc)die(Ecall);
  589.    if(argc==2&&isnull())delete(&len),argc--;
  590.    if(argc==1){
  591.       if(num(&m,&e,&z,&l)>=0)  /* numeric if true */
  592.          delete(&l),
  593.          stack("NUM",3);
  594.       else delete(&l),stack("CHAR",4);
  595.    }
  596.    else{
  597.       arg=delete(&len);
  598.       if(isnull())die(Enoarg);
  599.       if(len<1)die(Ecall);
  600.       switch(arg[0]&0xdf){ /* Depending on type, set i to the answer */
  601.       case 'A':arg=delete(&len);
  602.          if(!len){i=0;break;}
  603.          i=1;
  604.          while(len--)if((m=alphanum((arg++)[0]))<1||m==3)i=0;
  605.          break;
  606.       case 'B':arg=delete(&len);
  607.          if(!len){i=0;break;}
  608.          i=1;
  609.          while(len--)if((c=(arg++)[0])!='0'&&c!='1')i=0;
  610.          break;
  611.       case 'L':arg=delete(&len);
  612.          if(!len){i=0;break;}
  613.          i=1;
  614.          while(len--)if((c=(arg++)[0])<'a'||c>'z')i=0;
  615.          break;
  616.       case 'M':arg=delete(&len);
  617.          if(!len){i=0;break;}
  618.          i=1;
  619.          while(len--)if((c=(arg++)[0]|0x20)<'a'||c>'z')i=0;
  620.          break;
  621.       case 'N':i=(num(&m,&e,&z,&l)>=0),
  622.          delete(&len);
  623.          break;
  624.       case 'S':arg=delete(&len);
  625.          if(!len){i=0;break;}
  626.          i=1;
  627.          while(len--)if((m=rexxsymboldot((arg++)[0]))==0)i=0;
  628.          break;
  629.       case 'U':arg=delete(&len);
  630.          if(!len){i=0;break;}
  631.          i=1;
  632.          while(len--)if((c=(arg++)[0])<'A'||c>'Z')i=0;
  633.          break;
  634.       case 'W':numb=num(&m,&e,&z,&l),
  635.          i=numb>=0&&(z||isint(numb,l,e)),
  636.          delete(&len);
  637.          break;
  638.       case 'X':arg=delete(&len);
  639.          i=1,l=0;
  640.          while(len&&arg[0]==' ')arg++,len--;
  641.          while(len){
  642.             if(arg[0]==' '){
  643.                if(fst)fst=0;
  644.                else if(l%2)i=0;
  645.                l=0;
  646.                while(len&&arg[0]==' ')arg++,len--;
  647.             }
  648.             if(len==0)break;
  649.             c=(arg++)[0],len--;
  650.             if((c-='0')<0)i=0;
  651.             else if(c>9){
  652.                if((c-=7)<10)i=0;
  653.                if(c>15)if((c-=32)<10)i=0;
  654.                if(c>15)i=0;
  655.             }
  656.             l++;
  657.          }
  658.          if(!fst&&(l%2))i=0;
  659.          break;
  660.       default:die(Ecall);
  661.       }
  662.       stack((c=i+'0',&c),1);
  663.    }
  664. }
  665. void rxcopies(argc)
  666. int argc;
  667. {
  668.    int copies;
  669.    char *arg,*p;
  670.    char *mtest_old;
  671.    long mtest_diff;
  672.    int len;
  673.    int a;
  674.    if(argc!=2)die(Ecall);
  675.    if((copies=getint(1))<0)die(Ecall);
  676.    arg=delete(&len);
  677.    if(len<0)die(Enoarg);
  678.    if(!(len&&copies)){stack(cnull,0);return;}
  679.    if dtest(cstackptr,cstacklen,ecstackptr+len*copies+16,len*copies+16)
  680.       arg+=mtest_diff; /* Make room for the copies, then stack them directly */
  681.    for(a=len*(copies-1),p=arg+len;a--;p++[0]=arg++[0]);
  682.    ecstackptr+=align(len*=copies),
  683.    *(int *)(cstackptr+ecstackptr)=len,
  684.    ecstackptr+=four;
  685. }
  686. void rxspace(argc)
  687. int argc;
  688. {
  689.    char *arg;
  690.    int len;
  691.    int len1,len2;
  692.    char pad=' ';
  693.    int num=1;
  694.    int i;
  695.    if(argc<1||argc>3)die(Ecall);
  696.    if(argc==3){  /* First we find the character to pad with */
  697.       argc--;
  698.       arg=delete(&len);
  699.       if(len>=0){
  700.          if(len!=1)die(Ecall);
  701.          pad=arg[0];
  702.       }
  703.    }
  704.    if(argc==2){ /* Then the number of spaces between each word */
  705.       argc--;
  706.       if(isnull())delete(&len);
  707.       else if((num=getint(1))<0)die(Ecall);
  708.    }
  709.    arg=delete(&len); /* and finally the phrase to operate on */
  710.    if(len<0)die(Enoarg);
  711.    while(len--&&arg[0]==' ')arg++;
  712.    len++;
  713.    while(len--&&arg[len]==' ');
  714.    len++;
  715.    mtest(workptr,worklen,len*(num+1),len*(num+2));
  716.    for(len1=len2=0;len2<len;){ /* Make the result string in the workspace */
  717.       while((workptr[len1++]=arg[len2++])!=' '&&len2<=len);
  718.       while(len2<len&&arg[len2]==' ')len2++;
  719.       for(i=0,len1--;i<num;workptr[len1++]=pad)i++;
  720.    }
  721.    if(len)len1-=num;  /* Remove the padding from after the last word */
  722.    stack(workptr,len1);
  723. }
  724. void rxrange(argc)
  725. int argc;
  726. {
  727.    unsigned int c2=255;
  728.    unsigned int c1=0;
  729.    unsigned char *arg;
  730.    int len;
  731.    if(argc>2)die(Ecall);
  732.    if(argc>1){
  733.       arg=(unsigned char *)delete(&len);
  734.       if(len>=0)
  735.          if(len!=1)die(Ecall);
  736.          else c2=arg[0];
  737.    }
  738.    if(argc){
  739.       arg=(unsigned char *)delete(&len);
  740.       if(len>=0)
  741.          if(len!=1)die(Ecall);
  742.          else c1=arg[0];
  743.    }
  744.    if(c1>c2)c2+=256;
  745.    len=c2-c1+1;
  746.    mtest(cstackptr,cstacklen,ecstackptr+len+16,len+16);
  747.    for(arg=(unsigned char *)(cstackptr+ecstackptr);c1<=c2;(*(arg++))=(c1++)&255);
  748.    *(int *)(cstackptr+(ecstackptr+=align(len)))=len,
  749.    ecstackptr+=four;
  750. }
  751. void c2x(argc)
  752. int argc;
  753. {
  754.    char *arg;
  755.    int len;
  756.    int i;
  757.    if(argc!=1)die(Ecall);
  758.    arg=delete(&len);
  759.    mtest(workptr,worklen,len+len,len+len-worklen);
  760.    for(i=0;i<len;i++)xbyte(workptr+i+i,arg[i]);
  761.    stack(workptr,len+len);
  762. }
  763. void xbyte(where,what) /* Place two hex digits representing "what", "where" */
  764. char *where;
  765. unsigned char what;
  766. {
  767.    unsigned char c1=what>>4;
  768.    what&=15;
  769.    if(what>9)what+=7;
  770.    if(c1>9)c1+=7;
  771.    where[0]=c1+'0',where[1]=what+'0';
  772. }
  773. void c2d(argc)
  774. int argc;
  775. {
  776.    unsigned char *arg;
  777.    int len;
  778.    int n=-1;
  779.    unsigned int num=0;
  780.    unsigned char sign;
  781.    int s=0;
  782.    if(argc==2){
  783.       argc--;
  784.       if((n=getint(1))<0)die(Ecall);
  785.    }
  786.    if(argc!=1)die(Ecall);
  787.    arg=(unsigned char *)delete(&len);
  788.    if(n<0)n=len+1;
  789.    while(n-->0)
  790.       if(len>0){
  791.          num|=(sign=arg[--len])<<s;
  792.          if(sign&&s>=8*four||(int)num<0)die(Ecall);
  793.          s+=8;
  794.       }
  795.       else sign=0;
  796.    sign= -(sign>127);
  797.    while(s<8*four)num|=sign<<s,s+=8;
  798.    stackint((int)num);
  799. }
  800. void b2x(argc)
  801. int argc;
  802. {
  803.    char *arg;
  804.    int len;
  805.    int i,j,k;
  806.    unsigned char d,e;
  807.    if(argc!=1)die(Ecall);
  808.    arg=delete(&len);
  809.    mtest(workptr,worklen,len/8+2,len/8+2-worklen);
  810.    for(i=((len-1)&7)-7,k=0;i<len;i+=8){
  811.       for(d=0,j=i;j<i+8;j++){
  812.          if(j<0)j=0;
  813.          if((e=arg[j]-'0')>1)die(Ehex);
  814.          d=(d<<1)|e;
  815.       }
  816.       xbyte(workptr+k,d),k+=2;
  817.    }
  818.    stack(workptr,k);
  819. }
  820. void b2d(argc)
  821. int argc;
  822. {
  823.    char *arg;
  824.    int len;
  825.    int i,n=0;
  826.    unsigned char e;
  827.    if(argc!=1)die(Ecall);
  828.    arg=delete(&len);
  829.    for(i=0;i<len;i++){
  830.       if((e=arg[i]-'0')>1)die(Ehex);
  831.       n=(n<<1)|e;
  832.       if(n<0)die(Erange);
  833.    }
  834.    stackint(n);
  835. }
  836. void d2c(argc)
  837. int argc;
  838. {
  839.    unsigned int num,minus;
  840.    int n=-1;
  841.    int l;
  842.    unsigned char sign;
  843.    char *ans;
  844.    if(argc==2){
  845.       argc--;
  846.       if((n=getint(1))<0)die(Ecall);
  847.    }
  848.    if(argc!=1)die(Ecall);
  849.    num=(unsigned)getint(1);
  850.    minus=-num;
  851.    sign=-((int)num<0);
  852.    mtest(workptr,worklen,n<four?four:n,n+1+four);
  853.    if(n<0){
  854.       if(!num){
  855.          stack("",1); /* stack d2c(0) - the null char from "" */
  856.          return;
  857.       }
  858.       for(n=0,ans=workptr+four-1;num&−n++,num>>=8,minus>>=8)
  859.          *ans--=(char)num;
  860.       stack(++ans,n);
  861.       return;
  862.    }
  863.    for(l=n,ans=workptr+n-1;n--;num>>=8)*ans--=num?(char)num:sign;
  864.    stack(workptr,l);
  865. }
  866. void d2b(argc)
  867. int argc;
  868. {
  869.    int num;
  870.    char c[8*four];
  871.    int i;
  872.    if(argc!=1)die(Ecall);
  873.    if((num=getint(1))<0)die(Ecall);
  874.    if(!num)stack("00000000",8);
  875.    else{
  876.       for(i=8*four;num||(i&7);c[--i]=(num&1)+'0',num>>=1);
  877.       stack(c+i,8*four-i);
  878.    }
  879. }
  880. void d2x(argc)
  881. int argc;
  882. {
  883.    unsigned int num,minus;
  884.    unsigned char sign;
  885.    int l;
  886.    int n=-1;
  887.    char *ans;
  888.    if(argc==2){
  889.       argc--;
  890.       if((n=getint(1))<0)die(Ecall);
  891.    }
  892.    if(argc!=1)die(Ecall);
  893.    num=getint(1);
  894.    minus=-num;
  895.    sign=-((int)num<0);
  896.    if(n<0){
  897.       if(!num){stack("0",1);return;}
  898.       mtest(workptr,worklen,2*four,2*four);
  899.       for(n=0,ans=workptr+2*four-2;num&−n+=2,num>>=8,minus>>=8)
  900.          xbyte(ans,(char)num),ans-=2;
  901.       if((ans+=2)[0]==(sign?'F':'0')&&(!sign||ans[1]>'7'))ans++,n--;
  902.       stack(ans,n);
  903.    }
  904.    else{
  905.       mtest(workptr,worklen,n+1,n+1-worklen);
  906.       for(l=n,ans=workptr+n;n>0;n-=2,ans-=2,num>>=8)
  907.          xbyte(ans,num?(char)num:sign);
  908.       if(n<0)ans++;
  909.       stack(ans+2,l);
  910.    }
  911. }
  912. void x2c(argc)
  913. int argc;
  914. {
  915.    char *arg;
  916.    int len;
  917.    if(argc!=1)die(Ecall);
  918.    arg=delete(&len);
  919.    mtest(workptr,worklen,len+1,len+1-worklen);
  920.    memcpy(workptr,arg,len),
  921.    stackx(workptr,len);
  922. }
  923. void x2d(argc)
  924. int argc;
  925. {
  926.    char *arg;
  927.    int len;
  928.    int i;
  929.    int num=0;
  930.    int n=-1;
  931.    char c;
  932.    int k;
  933.    int minus=0;
  934.    if(argc==2){
  935.       if((n=getint(1))<0)die(Ecall);
  936.       argc--;
  937.    }
  938.    if(argc!=1)die(Ecall);
  939.    arg=delete(&len);
  940.    if(len<0)die(Enoarg);
  941.    if(n<0)n=len+1;
  942.    if(n==0){stack("0",1);return;}
  943.    if(n<=len){
  944.       k=n;
  945.       arg+=len-k;
  946.       if(arg[0]>='8')minus=(~(unsigned)0)<<(4*k);
  947.    }
  948.    else k=len;
  949.    for(i=0;i<k;i++){
  950.       if((c=arg[i]-'0')<0)die(Ehex);
  951.       if(c>9){
  952.          if((c-=7)<0)die(Ehex);
  953.          if(c>15)if((c-=32)<0||c>15)die(Ehex);
  954.       }
  955.       if((num=num*16+c)<0)die(Erange);
  956.    }
  957.    stackint(num|minus);
  958. }
  959. void x2b(argc)
  960. int argc;
  961. {
  962.    int i,j,a;
  963.    char *arg,*ans;
  964.    int len;
  965.    x2c(argc);
  966.    arg=delete(&len);
  967.    mtest(workptr,worklen,8*len+1,8*len+1-worklen);
  968.    for(ans=workptr,i=len;i--;arg++){
  969.       a=arg[0];
  970.       for(j=8;j--;ans++)ans[0]='0'+((a&(1<<j))!=0);
  971.    }
  972.    stack(workptr,len*8);
  973. }
  974.    
  975. void rxsystem(argc)
  976. int argc;
  977. {
  978.    char *arg;
  979.    int len;
  980.    FILE *p;
  981.    char c;
  982.    int rc;
  983.    int type;
  984.    if(argc!=1)die(Ecall);
  985.    arg=delete(&len);
  986.    arg[len]=0;
  987.    len=0;
  988.    if(p=popen(arg,"r")){ /* Open a pipe, read the output, close the pipe */
  989.       while(1){
  990.          c=getc(p);
  991.          if(feof(p)||ferror(p))break;
  992.          mtest(workptr,worklen,len+1,50);
  993.          workptr[len++]=c;
  994.       }
  995.       rc=pclose(p)/256;
  996.    }
  997.    else rc= -1;
  998.    stack(workptr,len);
  999.    if(rc<0||rc==1)type=Efailure;
  1000.    else type=Eerror;
  1001.    rcset(rc,type,arg);
  1002. }
  1003.  
  1004. int rxseterr(info,stream) /* Set rc to indicate the I/O error which just */
  1005. struct fileinfo *info;    /* occurred on file "info", named "stream" */
  1006. char *stream;
  1007. {
  1008.    extern int errno;
  1009.    int rc=0;
  1010.    if(feof(info->fp))rc=Eeof;
  1011.    if(ferror(info->fp))rc=errno;
  1012.    if(rc)info->errno=rc+Eerrno;
  1013.    else  info->errno=0;
  1014.    rcset(rc,Enotready,stream);
  1015.    return rc;
  1016. }
  1017.  
  1018. void rxpos(argc)
  1019. int argc;
  1020. {
  1021.    char *s1,*s2,*p;
  1022.    int l1,l2,start;
  1023.    if(argc!=2&&argc!=3)die(Ecall);
  1024.    if(argc==3&&isnull())argc--,delete(&l1);
  1025.    if(argc==3)start=getint(1);
  1026.    else start=1;
  1027.    if(--start<0)die(Erange);
  1028.    p=(s1=delete(&l1))+start;
  1029.    if(l1<0)die(Enoarg);
  1030.    l1-=start,
  1031.    s2=delete(&l2);
  1032.    if(l2<0)die(Enoarg);
  1033.    if(l2==0){stack("0",1);return;}
  1034.    while(l1>=l2&&memcmp(p,s2,l2))p++,l1--;
  1035.    if(l1<l2)stack("0",1);
  1036.    else stackint(p-s1+1);
  1037. }
  1038. void rxlastpos(argc)
  1039. int argc;
  1040. {
  1041.    char *s1,*s2,*p;
  1042.    int l1,l2,start;
  1043.    if(argc!=2&&argc!=3)die(Ecall);
  1044.    if(argc==3&&isnull())argc--,delete(&l1);
  1045.    if(argc==3){
  1046.       start=getint(1);
  1047.       if(start<1)die(Erange);
  1048.    }
  1049.    else start=0;
  1050.    s1=delete(&l1),
  1051.    s2=delete(&l2);
  1052.    if(l1<0||l2<0)die(Enoarg);
  1053.    if(!l2){stack("0",1);return;}
  1054.    if(start&&start<l1)l1=start;
  1055.    p=s1+l1-l2;
  1056.    while(p>=s1&&memcmp(p,s2,l2))p--;
  1057.    if(p<s1)stack("0",1);
  1058.    else stackint(p-s1+1);
  1059. }
  1060. void rxsubstr(argc)
  1061. int argc;
  1062. {
  1063.    char *arg;
  1064.    int len;
  1065.    int len1,len2;
  1066.    int i;
  1067.    char pad=' ';
  1068.    int num;
  1069.    int strlen= -1;
  1070.    if(argc>4||argc<2)die(Ecall);
  1071.    if(argc==4){
  1072.       arg=delete(&len);
  1073.       if(len>=0)
  1074.          if(len!=1)die(Ecall);
  1075.          else pad=arg[0];
  1076.    }
  1077.    if(argc>2&&isnull())delete(&len1),argc=2;
  1078.    if(argc>2)if((strlen=getint(1))<0)die(Ecall);
  1079.    num=getint(1);
  1080.    arg=delete(&len);
  1081.    if(len<0)die(Enoarg);
  1082.    strlen=len1=strlen<0?len-num+1:strlen; /* fix up the default length */
  1083.    if(strlen<=0){          /* e.g. in substr("xyz",73) */
  1084.       stack("",0);
  1085.       return;
  1086.    }
  1087.    mtest(workptr,worklen,len1+5,len1+5);
  1088.    for(i=0;num<1&&len1;workptr[i++]=pad)num++,len1--; /* The initial padding */
  1089.    len2=len-num+1<len1?len-num+1:len1;
  1090.    if(len2<=0)len2=0;
  1091.    memcpy(workptr+i,arg+num-1,len2);  /* The substring */
  1092.    i+=len2;
  1093.    len1-=len2;
  1094.    for(;len1--;workptr[i++]=pad);    /* The final padding */
  1095.    stack(workptr,strlen);
  1096. }
  1097. void rxcentre(argc)
  1098. int argc;
  1099. {
  1100.    char *arg;
  1101.    int len;
  1102.    int num;
  1103.    int i;
  1104.    int spleft;
  1105.    char pad=' ';
  1106.    if(argc==3){
  1107.       arg=delete(&len);
  1108.       if(len>=0)
  1109.          if(len!=1)die(Ecall);
  1110.          else pad=arg[0];
  1111.       argc--;
  1112.    }
  1113.    if(argc!=2)die(Ecall);
  1114.    if((num=getint(1))<=0)die(Ecall);
  1115.    arg=delete(&len);
  1116.    if(len<0)die(Enoarg);
  1117.    mtest(workptr,worklen,num+5,num+5);
  1118.    if(len>=num)memcpy(workptr,arg+(len-num)/2,num); /* centre window on text */
  1119.    else {                                           /* centre text in window */
  1120.       spleft=(num-len)/2;
  1121.       for(i=0;i<spleft;workptr[i++]=pad);
  1122.       memcpy(workptr+i,arg,len);
  1123.       for(i+=len;i<num;workptr[i++]=pad);
  1124.    }
  1125.    stack(workptr,num);
  1126. }
  1127. void rxjustify(argc)
  1128. int argc;
  1129. {
  1130.    char *arg,*ptr;
  1131.    int len;
  1132.    int num;
  1133.    int i,j;
  1134.    int sp;
  1135.    int n=0;
  1136.    int a;
  1137.    char pad=' ';
  1138.    if(argc==3){
  1139.       arg=delete(&len);
  1140.       if(len>=0)
  1141.          if(len!=1)die(Ecall);
  1142.          else pad=arg[0];
  1143.       argc--;
  1144.    }
  1145.    if(argc!=2)die(Ecall);
  1146.    if((num=getint(1))<=0)die(Ecall);
  1147.    rxspace(1);
  1148.    arg=delete(&len);
  1149.    if((sp=num-len)<=0){
  1150.       for(len=num,ptr=arg;len--;ptr++)if(ptr[0]==' ')ptr[0]=pad;
  1151.       stack(arg,num);
  1152.       return;
  1153.    }
  1154.    mtest(workptr,worklen,num+5,num+5);
  1155.    for(i=0;i<len;i++)if(arg[i]==' ')n++;
  1156.    if(!n){
  1157.       memcpy(workptr,arg,len);
  1158.       for(i=len;i<num;workptr[i++]=pad);
  1159.    }
  1160.    else{
  1161.       a=n/2;
  1162.       for(i=j=0;i<len;workptr[j++]=arg[i++])
  1163.          if(arg[i]==' '){
  1164.             arg[i]=pad;
  1165.             for(a+=sp;a>=n;a-=n)workptr[j++]=pad;
  1166.          }
  1167.    }
  1168.    stack(workptr,num);
  1169. }
  1170.  
  1171. void rxarg(argc)
  1172. int argc;
  1173. {
  1174.    int n;
  1175.    int i;
  1176.    int ex;
  1177.    char opt='A';
  1178.    char *arg;
  1179.    for(n=0;curargs[n];n++); /* count arguments to current procedure */
  1180.    if(argc>2)die(Ecall);
  1181.    if(argc>0&&isnull()){
  1182.       delete(&i);
  1183.       argc--;
  1184.       if(argc>0&&isnull()){
  1185.          delete(&i);
  1186.          argc--;
  1187.       }
  1188.    }
  1189.    if(argc==0){stackint(n);return;}
  1190.    if(argc==2){
  1191.       arg=delete(&i);
  1192.       if(i<1)die(Ecall);
  1193.       if((opt=arg[0]&0xdf)!='E'&&opt!='O')die(Ecall);
  1194.    }
  1195.    i=getint(1);
  1196.    if(i-- <=0)die(Ecall);
  1197.    ex=(i<n &&curarglen[i]>=0);
  1198.    switch(opt){
  1199.       case 'A':if(ex)stack(curargs[i],curarglen[i]);
  1200.          else stack(cnull,0);
  1201.          break;
  1202.       case 'O':ex=!ex;
  1203.       case 'E':stack((opt='0'+ex,&opt),1);
  1204.    }
  1205. }
  1206. void rxabbrev(argc)
  1207. int argc;
  1208. {
  1209.    int al= -1;
  1210.    char *longs,*shorts;
  1211.    int longl,shortl;
  1212.    char c;
  1213.    if(argc==3&&isnull())argc--,delete(&longl);
  1214.    if(argc==3)if((argc--,al=getint(1))<0)die(Ecall);
  1215.    if(argc!=2)die(Ecall);
  1216.    shorts=delete(&shortl);
  1217.    longs=delete(&longl);
  1218.    if(shortl<0||longl<0)die(Enoarg);
  1219.    if(al<0)al=shortl;
  1220.    c= '1'-(al>shortl||shortl>longl||memcmp(longs,shorts,shortl)),
  1221.    stack(&c,1);
  1222. }
  1223.  
  1224. void rxabs(argc)
  1225. int argc;
  1226. {
  1227.    int m,e,z,l,n;
  1228.    if(argc!=1)die(Ecall);
  1229.    if((n=num(&m,&e,&z,&l))<0)die(Enum);
  1230.    delete(&m);
  1231.    stacknum(workptr+n,l,e,0);
  1232. }
  1233.  
  1234. void rxcompare(argc)
  1235. int argc;
  1236. {
  1237.    char pad=' ';
  1238.    char *s1,*s2;
  1239.    int l1,l2,l3;
  1240.    int i;
  1241.    if(argc==3){
  1242.       s1=delete(&l1);
  1243.       if(l1>=0)
  1244.          if(l1!=1)die(Ecall);
  1245.          else pad=s1[0];
  1246.       argc--;
  1247.    }
  1248.    if(argc!=2)die(Ecall);
  1249.    s2=delete(&l2),
  1250.    s1=delete(&l1);
  1251.    if(l1<0||l2<0)die(Enoarg);
  1252.    l3=((l1<l2)?l2:l1);  /* the length of the larger string */
  1253.    for(i=0;i<l3&&(i<l2?s2[i]:pad)==(i<l1?s1[i]:pad);i++);
  1254.    if(i++==l3)i=0;
  1255.    stackint(i);
  1256. }
  1257.  
  1258. void rxdelstr(argc)
  1259. int argc;
  1260. {
  1261.    int n,l,d= -1;
  1262.    int osp;
  1263.    char *s;
  1264.    if(argc==3){
  1265.       argc--;
  1266.       if(isnull())delete(&l);
  1267.       else if((d=getint(1))<0)die(Ecall);
  1268.    }
  1269.    if(argc!=2)die(Ecall);
  1270.    if((n=getint(1))<1)die(Ecall);
  1271.    osp=ecstackptr;
  1272.    s=delete(&l);
  1273.    if(l<0)die(Enoarg);
  1274.    if(n>l||!d){ecstackptr=osp;return;}/* delete nothing:return the old string*/
  1275.    mtest(workptr,worklen,l,l);
  1276.    n--;
  1277.    if(d<0||n+d>l)d=l-n;
  1278.    memcpy(workptr,s,n),
  1279.    memcpy(workptr+n,s+n+d,l-n-d);
  1280.    stack(workptr,l-d);
  1281. }
  1282.  
  1283. void rxdelword(argc)
  1284. int argc;
  1285. {
  1286.    int n,l,d= -1,n1,d1,l1,i;
  1287.    int osp;
  1288.    char *s;
  1289.    if(argc==3){
  1290.       argc--;
  1291.       if(isnull())delete(&l);
  1292.       else if((d=getint(1))<0)die(Ecall);
  1293.    }
  1294.    if(argc!=2)die(Ecall);
  1295.    if((n=getint(1))<1)die(Ecall);
  1296.    osp=ecstackptr;
  1297.    s=delete(&l1);
  1298.    if(l1<0)die(Enoarg);
  1299.    for(i=0;i<l1&&s[i]==' ';i++);
  1300.    if(i==l1||!d){ecstackptr=osp;return;}
  1301.    n--;
  1302.    for(l=0;i<l1;l++){
  1303.       if(l==n)n1=i;
  1304.       if(l==n+d&&d>0)d1=i-n1;
  1305.       while(i<l1&&s[i]!=' ')i++;
  1306.       while(i<l1&&s[i]==' ')i++;
  1307.    }
  1308.    if(n>l-1){ecstackptr=osp;return;}
  1309.    mtest(workptr,worklen,l1,l1);
  1310.    if(d<0||n+d>l-1)d1=l1-n1;
  1311.    memcpy(workptr,s,n1),
  1312.    memcpy(workptr+n1,s+n1+d1,l1-n1-d1);
  1313.    stack(workptr,l1-d1);
  1314. }
  1315.  
  1316. void rxinsert(argc)
  1317. int argc;
  1318. {
  1319.    char *new,*target;
  1320.    int nl,tl;
  1321.    int n=0,length= -1;
  1322.    int i;
  1323.    char pad=' ';
  1324.    if(argc==5){
  1325.       argc--;
  1326.       new=delete(&nl);
  1327.       if(nl>=0)
  1328.          if(nl==1)pad=new[0];
  1329.          else die(Ecall);
  1330.    }
  1331.    if(argc==4){
  1332.       argc--;
  1333.       if(isnull())delete(&nl);
  1334.       else if((length=getint(1))<0)die(Ecall);
  1335.    }
  1336.    if(argc==3){
  1337.       argc--;
  1338.       if(isnull())delete(&nl);
  1339.       else if((n=getint(1))<0)die(Ecall);
  1340.    }
  1341.    if(argc!=2)die(Ecall);
  1342.    target=delete(&tl);
  1343.    new=delete(&nl);
  1344.    if(tl<0||nl<0)die(Enoarg);
  1345.    if(length<0)length=nl;
  1346.    mtest(workptr,worklen,length+n+tl,length+n+tl);
  1347.    memcpy(workptr,target,n<tl?n:tl);
  1348.    if(n>tl)for(i=tl;i<n;workptr[i++]=pad);
  1349.    memcpy(workptr+n,new,length<nl?length:nl);
  1350.    if(length>nl)for(i=nl;i<length;workptr[i++ +n]=pad);
  1351.    if(n<tl)memcpy(workptr+n+length,target+n,tl-n);
  1352.    else tl=n;
  1353.    stack(workptr,tl+length);
  1354. }
  1355.  
  1356. void rxminmax(argc,op) /* Calculate the minimum/maximum of a list of numbers */
  1357. int argc;   /* How many numbers are supplied */
  1358. int op;     /* What comparison operator to use */
  1359. {
  1360.    int m1,z1,e1,l1,n1,m2,z2,e2,l2,n2,d,owp;
  1361.    if(!argc)die(Enoarg);
  1362.    if((n1=num(&m1,&e1,&z1,&l1))<0)die(Enum);
  1363.    delete(&d);
  1364.    owp=eworkptr;
  1365.    while(--argc){
  1366.       eworkptr=owp;
  1367.       if((n2=num(&m2,&e2,&z2,&l2))<0)die(Enum);
  1368.       stacknum(workptr+n1,l1,e1,m1);
  1369.       binrel(op);
  1370.       if((delete(&d))[0]=='1')n1=n2,m1=m2,e1=e2,l1=l2,owp=eworkptr;
  1371.    }
  1372.    stacknum(workptr+n1,l1,e1,m1);
  1373. }
  1374.  
  1375. void rxmax(argc)
  1376. int argc;
  1377. {
  1378.    rxminmax(argc,OPgeq);
  1379. }
  1380.  
  1381. void rxmin(argc)
  1382. int argc;
  1383. {
  1384.    rxminmax(argc,OPleq);
  1385. }
  1386.  
  1387. void rxoverlay(argc)
  1388. int argc;
  1389. {
  1390.    char *new,*target;
  1391.    int nl,tl;
  1392.    int n=1,length= -1;
  1393.    int i;
  1394.    char pad=' ';
  1395.    if(argc==5){
  1396.       argc--;
  1397.       new=delete(&nl);
  1398.       if(nl>=0)
  1399.          if(nl==1)pad=new[0];
  1400.          else die(Ecall);
  1401.    }
  1402.    if(argc==4){
  1403.       argc--;
  1404.       if(isnull())delete(&nl);
  1405.       else if((length=getint(1))<0)die(Ecall);
  1406.    }
  1407.    if(argc==3){
  1408.       argc--;
  1409.       if(isnull())delete(&nl);
  1410.       else if((n=getint(1))<=0)die(Ecall);
  1411.    }
  1412.    n--;
  1413.    if(argc!=2)die(Ecall);
  1414.    target=delete(&tl);
  1415.    new=delete(&nl);
  1416.    if(tl<0||nl<0)die(Enoarg);
  1417.    if(length<0)length=nl;
  1418.    mtest(workptr,worklen,length+n+tl,length+n+tl);
  1419.    memcpy(workptr,target,n<tl?n:tl);
  1420.    if(n>tl)for(i=tl;i<n;workptr[i++]=pad);
  1421.    memcpy(workptr+n,new,length<nl?length:nl);
  1422.    if(length>nl)for(i=nl;i<length;workptr[i++ +n]=pad);
  1423.    if(n+length<tl)memcpy(workptr+n+length,target+n+length,tl-n-length);
  1424.    else tl=n+length;
  1425.    stack(workptr,tl);
  1426. }
  1427.  
  1428. void rxrandom(argc)
  1429. int argc;
  1430. {
  1431.    struct timeval t1;
  1432.    struct timezone tz;
  1433.    int min=0,max=999;
  1434.    int dummy;
  1435.    long random();
  1436.    unsigned long r;
  1437.    if(argc==3){
  1438.       argc--;
  1439.       srandom(getint(1)),timeflag|=4;
  1440.    }
  1441.    if(!(timeflag&4)){
  1442.       timeflag|=4;
  1443.       gettimeofday(&t1,&tz);
  1444.       srandom(t1.tv_sec*50+(t1.tv_usec/19999));
  1445.    }
  1446.    if(argc>2)die(Ecall);
  1447.    if(argc&&isnull())argc--,delete(&dummy);
  1448.    if(argc&&isnull())argc--,delete(&dummy);
  1449.    if(argc)argc--,max=getint(1);
  1450.    if(argc)
  1451.       if(isnull())delete(&dummy);
  1452.       else min=getint(1);
  1453.    if(min>max||max-min>100000)die(Ecall);
  1454.    if(min==max)r=0;
  1455.    else max=max-min+1,
  1456.         r=(unsigned long)random()%max;
  1457.    stackint((int)r+min);
  1458. }
  1459.  
  1460. void rxreverse(argc)
  1461. int argc;
  1462. {
  1463.    char *s;
  1464.    int i,l,l2;
  1465.    char c;
  1466.    if(argc!=1)die(Ecall);
  1467.    s=undelete(&l);
  1468.    l2=l--/2;
  1469.    for(i=0;i<l2;i++)c=s[i],s[i]=s[l-i],s[l-i]=c;
  1470. }
  1471.  
  1472. void rxsign(argc)
  1473. int argc;
  1474. {
  1475.    int m,z,e,l;
  1476.    char c;
  1477.    if(argc!=1)die(Ecall);
  1478.    if(num(&m,&e,&z,&l)<0)die(Enum);
  1479.    delete(&l);
  1480.    if(m)stack("-1",2);
  1481.    else c='1'-z,stack(&c,1);
  1482. }
  1483.  
  1484. void rxsubword(argc)
  1485. int argc;
  1486. {
  1487.    char *s;
  1488.    int l,n,k= -1,i,n1,k1,l1;
  1489.    if(argc==3){
  1490.       if((k=getint(1))<0)die(Ecall);
  1491.       argc--;
  1492.    }
  1493.    if(argc!=2)die(Ecall);
  1494.    if((n=getint(1))<=0)die(Ecall);
  1495.    s=delete(&l1);
  1496.    if(l1<0)die(Enoarg);
  1497.    for(i=0;i<l1&&s[i]==' ';i++);
  1498.    n--;
  1499.    for(l=0;i<l1;l++){
  1500.       if(n==l)n1=i;
  1501.       if(k>=0&&k+n==l)k1=i-n1;
  1502.       while(i<l1&&s[i]!=' ')i++;
  1503.       while(i<l1&&s[i]==' ')i++;
  1504.    }
  1505.    if(n>=l||k==0){stack(cnull,0);return;}
  1506.    if(k<0||k+n>=l)k1=l1-n1;
  1507.    while(k1>0&&s[n1+k1-1]==' ')k1--;
  1508.    stack(s+n1,k1);
  1509. }
  1510.  
  1511. void rxsymbol(argc)
  1512. int argc;
  1513. {
  1514.    char *arg;
  1515.    int len,good;
  1516.    int m,e,z,l;
  1517.    if(argc!=1)die(Ecall);
  1518.    if(num(&m,&e,&z,&l)>=0){
  1519.       delete(&l);
  1520.       stack("LIT",3); /* (was NUM) All numbers are constant symbols */
  1521.    }
  1522.    else{
  1523.       arg=rxgetname(&len,&good);
  1524.       if(!len)good=0;
  1525. /*    if(good==1&&rexxsymbol(arg[0]&0x7f)<1)good=0; */
  1526. /* Constant symbols give "LIT"; uncomment the above to give "BAD" */
  1527.       if(good&&varget(arg,len,&l)) stack("VAR",3);
  1528.       else if(!good)stack("BAD",3);
  1529.       else stack("LIT",3);
  1530.    }
  1531. }
  1532.  
  1533. void rxlate(argc)
  1534. int argc;
  1535. {
  1536.    char *s,*ti,*to;
  1537.    int sl,til= -1,tol=-1;
  1538.    int j;
  1539.    char pad=' ';
  1540.    if(argc==4){
  1541.       s=delete(&sl);
  1542.       if(sl==1)pad=s[0];
  1543.       else die(Ecall);
  1544.       argc--;
  1545.    }
  1546.    if(argc==3)argc--,ti=delete(&til);
  1547.    if(argc==2)argc--,to=delete(&tol);
  1548.    if(argc!=1)die(Ecall);
  1549.    s=undelete(&sl);
  1550.    if(sl<0)die(Enoarg);
  1551.    if(tol==-1&&til== -1)for(;sl--;s++)s[0]=uc(s[0]);
  1552.    else for(;sl--;s++){
  1553.       if(til== -1)j=s[0];
  1554.       else{
  1555.          for(j=0;j<til&&s[0]!=ti[j];j++);
  1556.          if(j==til)continue;
  1557.       }
  1558.       if(j>=tol)s[0]=pad;
  1559.       else s[0]=to[j];
  1560.    }
  1561. }
  1562.  
  1563. void rxtrunc(argc)
  1564. int argc;
  1565. {
  1566.    int d=0,n,m,e,z,l,i;
  1567.    char *p;
  1568.    if(argc==2){
  1569.       if(isnull())delete(&l);
  1570.       else if((d=getint(1))<0||d>5000)die(Ecall);
  1571.       argc--;
  1572.    }
  1573.    if(argc!=1)die(Ecall);
  1574.    eworkptr=2; /* Save room for a carry digits */
  1575.    if((n=num(&m,&e,&z,&l))<0)die(Enum); /* Get the number to truncate */
  1576.    delete(&i);
  1577.    if(e>0)i=l+d+e+5;
  1578.    else i=l+d+5;
  1579.    mtest(workptr,worklen,i,i);
  1580.    p=workptr+n;
  1581.    if(l>precision)  /* round it to precision before truncating */
  1582.    if(p[l=precision]>='5'){
  1583.       for(i=l-1;i>=0;i--){
  1584.          p[i]++;
  1585.          if(p[i]<='9')break;
  1586.          p[i]='0';
  1587.       }
  1588.       if(i<0)(--p)[0]='1',e++;
  1589.    }
  1590.    for(i=l;i<=e;p[i++]='0'); /* Extend the number to the decimal point */
  1591.    if(d==0&&e<0){p[0]='0';stack(p,1);return;}  /* 0 for trunc(x) where |x|<1 */
  1592.    if(d>0){
  1593.       if(e<0){
  1594.          if(e<-d)e= -d-1;
  1595.          for(i=l;i--;)p[i-e]=p[i];
  1596.          for(i=0;i<-e;p[i++]='0');
  1597.          l-=e;
  1598.          e=0;
  1599.       }
  1600.       if(l>e+1)for(i=l;i>e;i--)p[i+1]=p[i];
  1601.       p[e+1]='.';
  1602.       if(l<e+2)l=e+2;
  1603.       else l++;
  1604.       for(i=l;i<e+d+2;p[i++]='0');
  1605.       d++;
  1606.    }
  1607.    if(m)(--p)[0]='-',d++;
  1608.    stack(p,d+e+1);
  1609. }
  1610.  
  1611. void rxverify(argc)
  1612. int argc;
  1613. {
  1614.    char *s,*r;
  1615.    int sl,rl,st=1,opt=0;
  1616.    int i,j;
  1617.    if(argc==4){
  1618.       argc--;
  1619.       if(isnull())delete(&sl);
  1620.       else if((st=getint(1))<1)die(Ecall);
  1621.    }
  1622.    if(argc==3){
  1623.       argc--;
  1624.       s=delete(&sl);
  1625.       if(sl>=0){
  1626.          if(sl==0)die(Ecall);
  1627.          switch(s[0]&0xdf){
  1628.             case 'M':opt=1;
  1629.             case 'N':break;
  1630.             default:die(Ecall);
  1631.          }
  1632.       }
  1633.    }
  1634.    if(argc!=2)die(Ecall);
  1635.    r=delete(&rl),
  1636.    s=delete(&sl);
  1637.    if(rl<0||sl<0)die(Enoarg);
  1638.    if(st>sl)i=0;
  1639.    else{
  1640.       s+=(--st);
  1641.       for(i=st;i<sl;i++,s++){
  1642.          for(j=0;j<rl&&s[0]!=r[j];j++);
  1643.          if((j==rl)^opt)break;
  1644.       }
  1645.       if(i==sl)i=0;
  1646.       else i++;
  1647.    }
  1648.    stackint(i); 
  1649. }
  1650.  
  1651. void rxword(argc)
  1652. int argc;
  1653. {
  1654.    if(argc!=2)die(Ecall);
  1655.    stack("1",1);
  1656.    rxsubword(3);
  1657. }
  1658.  
  1659. void rxwordindex(argc)
  1660. int argc;
  1661. {
  1662.    char *s;
  1663.    int sl,n,i,l;
  1664.    if(argc!=2)die(Ecall);
  1665.    if((n=getint(1))<1)die(Ecall);
  1666.    s=delete(&sl);
  1667.    if(sl<0)die(Enoarg);
  1668.    for(i=0;i<sl&&s[0]==' ';s++,i++);
  1669.    n--;
  1670.    for(l=0;i<sl;l++){
  1671.       if(n==l)break;
  1672.       while(i<sl&&s[0]!=' ')i++,s++;
  1673.       while(i<sl&&s[0]==' ')i++,s++;
  1674.    }
  1675.    if(i==sl)i=0;
  1676.    else i++;
  1677.    stackint(i);
  1678. }
  1679.  
  1680. void rxwordlength(argc)
  1681. int argc;
  1682. {
  1683.    rxword(argc);
  1684.    rxlength(1);
  1685. }
  1686.  
  1687. void rxwordpos(argc)
  1688. int argc;
  1689. {
  1690.    char *p,*s;
  1691.    int pl,sl,st=1;
  1692.    int i,l,j,k;
  1693.    if(argc==3){
  1694.       if((st=getint(1))<1)die(Ecall);
  1695.       argc--;
  1696.    }
  1697.    if(argc!=2)die(Ecall);
  1698.    s=delete(&sl),
  1699.    p=delete(&pl);
  1700.    if(sl<0||pl<0)die(Enoarg);
  1701.    for(i=0;i<sl&&s[0]==' ';s++,i++);
  1702.    while(pl&&p[0]==' ')p++,pl--;
  1703.    while(pl--&&p[pl]==' ');
  1704.    if(!++pl){stack("0",1);return;}
  1705.    st--;
  1706.    for(l=0;i<sl;l++){
  1707.       if(l>=st){
  1708.          for(j=k=0;j<pl&&k<sl-i;j++,k++){
  1709.             if(s[k]!=p[j])break;
  1710.             if(s[k]!=' ')continue;
  1711.             while(++k<sl-i&&s[k]==' ');
  1712.             while(++j<pl&&p[j]==' ');
  1713.             j--,k--;
  1714.          }
  1715.          if(j==pl)break;
  1716.          if(k==sl-i){l= -1;break;}
  1717.       }
  1718.       while(i<sl&&s[0]!=' ')i++,s++;
  1719.       while(i<sl&&s[0]==' ')i++,s++;
  1720.    }
  1721.    if(i==sl)l=0;
  1722.    else l++;
  1723.    stackint(l);
  1724. }
  1725.  
  1726. void rxwords(argc)
  1727. int argc;
  1728. {
  1729.    char *s;
  1730.    int l1,l;
  1731.    if(argc!=1)die(Ecall);
  1732.    s=delete(&l1);
  1733.    while(l1&&s[0]==' ')s++,l1--;
  1734.    for(l=0;l1;l++){
  1735.       while(l1&&s[0]!=' ')s++,l1--;
  1736.       while(l1&&s[0]==' ')s++,l1--;
  1737.    }
  1738.    stackint(l);
  1739. }
  1740.  
  1741. void rxdigits(argc)
  1742. int argc;
  1743. {
  1744.    if(argc)die(Ecall);
  1745.    stackint(precision);
  1746. }
  1747.  
  1748. void rxfuzz(argc)
  1749. int argc;
  1750. {
  1751.    if(argc)die(Ecall);
  1752.    stackint(precision-fuzz);
  1753. }
  1754.  
  1755. void rxaddress(argc)
  1756. int argc;
  1757. {
  1758.    extern char *address; /* from rexx.c */
  1759.    if(argc)die(Ecall);
  1760.    stack(address,strlen(address));
  1761. }
  1762.  
  1763. void rxtrace(argc)
  1764. int argc;
  1765. {
  1766.    char *arg;
  1767.    int len;
  1768.    char ans[2];
  1769.    int q=0;
  1770.    if(argc>1)die(Ecall);
  1771.    if(trcflag&Tinteract)ans[q++]='?';
  1772.    switch(trcflag&~Tinteract&0xff){
  1773.       case Tclauses:             ans[q]='A';break;
  1774.       case Tcommands|Terrors:    ans[q]='C';break;
  1775.       case Terrors:              ans[q]='E';break;
  1776.       case Tfailures:            ans[q]='F';break;
  1777.       case Tclauses|Tintermed:   ans[q]='I';break;
  1778.       case Tlabels:              ans[q]='L';break;
  1779.       case 0:                    ans[q]='O';break;
  1780.       case Tresults|Tclauses:    ans[q]='R';
  1781.    }
  1782.    if(argc){
  1783.       arg=delete(&len);
  1784.       if(!(trcflag&Tinteract)&&interact<0 ||
  1785.           (interact==interplev-1 && interact>=0)){
  1786.                /* if interactive trace, only interpret
  1787.                   trace in the actual command, also use old trace flag
  1788.                   as the starting value */
  1789.          if (interact>=0)trclp=2,trcflag=otrcflag;
  1790.          arg[len]=0;
  1791.          settrace(arg);
  1792.       }
  1793.    }
  1794.    stack(ans,++q);
  1795. }
  1796.  
  1797. void rxform(argc)
  1798. int argc;
  1799. {
  1800.    if(argc)die(Ecall);
  1801.    if(numform)stack("ENGINEERING",11);
  1802.          else stack("SCIENTIFIC",10);
  1803. }
  1804.  
  1805. void rxformat(argc)
  1806. int argc;
  1807. {
  1808.    int n,l,e,m,z;
  1809.    int before=0,after= -1, expp= -1,expt= precision;
  1810.    char *ptr1;
  1811.    int len1=0;
  1812.    int i;
  1813.    int p;
  1814.    int c=argc;
  1815.    char *num1;
  1816.    int exp;
  1817.    if(argc==5){  /* Get the value of expt */
  1818.       argc--;
  1819.       if(!isnull()){if((expt=getint(1))<0)die(Ecall);}
  1820.       else delete(&i);
  1821.    }
  1822.    if(argc==4){  /* Get the value of expp */
  1823.       argc--;
  1824.       if(!isnull()){if((expp=getint(1))<0)die(Ecall);}
  1825.       else delete(&i);
  1826.    }
  1827.    if(argc==3){  /* Get the value of after */
  1828.       argc--;
  1829.       if(!isnull()){if((after=getint(1))<0)die(Ecall);}
  1830.       else delete(&i);
  1831.    }
  1832.    if(argc==2){  /* Get the value of before */
  1833.       argc--;
  1834.       if(!isnull()){if((before=getint(1))<=0)die(Ecall);}
  1835.       else delete(&i);
  1836.    }
  1837.    if(argc!=1)die(Ecall); /* The number to be formatted must be supplied */
  1838.    eworkptr=1;            /* allow for overflow one place to the left */
  1839.    if((n=num(&m,&e,&z,&l))<0)die(Enum);
  1840.    delete(&i);
  1841.    num1=n+workptr;
  1842.    if(c==1){ /* A simple format(number) command, in which case */
  1843.       stacknum(num1,l,e,m);                 /* format normally */
  1844.       return;
  1845.    }
  1846.    if(l>precision) /* Before processing, the number is rounded to digits() */
  1847.       if(num1[l=precision]>='5'){
  1848.          for(i=l-1;i>=0;i--){
  1849.             if(++num1[i]<='9')break;
  1850.             num1[i]='0';
  1851.          }
  1852.          if(i<0)*--num1='1';
  1853.       }
  1854.    i=l+before+after+expp+30;
  1855.    mtest(cstackptr,cstacklen,i+ecstackptr,i);
  1856.    ptr1=cstackptr+ecstackptr;
  1857.    if(z)num1[0]='0',m=e=0,l=1;              /* adjust zero to be just "0" */
  1858.    if(exp=((e<expt&&!(e<0&&l-e-1>2*expt))||!expp)) {/* no exponent */
  1859.       if(e<0)n=1+m;  /* calculate number of places before . */
  1860.       else n=e+1+m;
  1861.       p=1+e;
  1862.    }
  1863.    else{
  1864.       if(numform)n=1+m+e%3; /* number of places before . in expon. notation */
  1865.       else n=1+m;
  1866.       p=n-m;
  1867.    }
  1868.    if((p+=after)>precision||after<0)p=precision; /* what precision? */
  1869.    if(l>p&&p>=0)  /* if l>p, round the number; if p<0 it needs rounding down */
  1870.       if(num1[l=p]>='5'){              /* anyway, so we don't need to bother */
  1871.          for(i=l-1;i>=0;i--){
  1872.             if(++num1[i]<='9')break;
  1873.             num1[i]='0';
  1874.          }
  1875.          if(i<0){
  1876.             (--num1)[0]='1';
  1877.             if(!l)l++; /* if that's the only '1' in the whole number, */
  1878.                        /* count it. */
  1879.             if(++e==expt&&expt&&expp)
  1880.                exp=0; /* just nudged into exponential form */
  1881.             if(exp){if(e>0)n++;}
  1882.             else
  1883.                if(numform)n=1+m+e%3;
  1884.                else n=1+m;
  1885.          }
  1886.       }
  1887.    /* should now have number rounded to fit into format, and n
  1888.       is the number of characters required for the integer part */
  1889.    if(before<n&&before)die(Eformat);
  1890.    for(n=before-n;n>0;n--)ptr1[len1++]=' ';
  1891.    if(m)ptr1[len1++]='-';
  1892.    if(exp){/* stack floating point number; no exponent */
  1893.       if(e<0){
  1894.          ptr1[len1++]='0';
  1895.          if(after){
  1896.             ptr1[len1++]='.';
  1897.             for(i= -1;i>e&&after;i--)ptr1[len1++]='0',after--;
  1898.          }
  1899.       }
  1900.       while(l&&(e>=0||after)){
  1901.          ptr1[len1++]=num1[0],
  1902.          num1++,
  1903.          l--,
  1904.          e--;
  1905.          if(l&&e==-1&&after)ptr1[len1++]='.';
  1906.          if(e<-1)after--;
  1907.       }
  1908.       while(e>-1)ptr1[len1++]='0',e--;
  1909.       if(after>0){
  1910.          if(e==-1)ptr1[len1++]='.';
  1911.          while(after--)ptr1[len1++]='0';
  1912.       }
  1913.    }
  1914.    else{/*stack floating point in appropriate form with exponent */
  1915.       ptr1[len1++]=num1[0];
  1916.       if(numform)while(e%3)
  1917.             e--,
  1918.             ptr1[len1++]=((--l)>0 ? (++num1)[0] : '0');
  1919.       else --l;
  1920.       if(l>0&&after){
  1921.          ptr1[len1++]='.';
  1922.          while(l--&&after)ptr1[len1++]=(++num1)[0],after--;
  1923.          while(after-- >0)ptr1[len1++]='0';
  1924.       }
  1925.       if(!e){
  1926.          if(expp>0)for(i=expp+2;i--;ptr1[len1++]=' ');
  1927.       }
  1928.       else{
  1929.          ptr1[len1++]='E',
  1930.          ptr1[len1++]= e<0 ? '-' : '+',
  1931.          e=abs(e);
  1932.          for(p=0,i=1;i<=e;i*=10,p++);
  1933.          if(expp<0)expp=p;
  1934.          if(expp<p)die(Eformat);
  1935.          for(p=expp-p;p--;ptr1[len1++]='0');
  1936.          for(i/=10;i>=1;i/=10)
  1937.             ptr1[len1++]=e/i+'0',
  1938.             e%=i;
  1939.       }
  1940.    }
  1941.    *(int *)(ptr1+align(len1))=len1;
  1942.    ecstackptr+=align(len1)+four;
  1943. }
  1944.  
  1945. void rxqueued(argc)
  1946. int argc;
  1947. {
  1948.    int l;
  1949.    static char buff[8];
  1950.    if(argc)die(Ecall);
  1951.    if(write(rxstacksock,"N",1)<1)die(Esys);
  1952.    if(read(rxstacksock,buff,7)<7)die(Esys);
  1953.    sscanf(buff,"%x",&l);
  1954.    stackint(l);
  1955. }
  1956.  
  1957. void rxlinesize(argc)
  1958. int argc;
  1959. {
  1960.    int ans;
  1961.    struct winsize sz;
  1962.    if(argc)die(Ecall);
  1963.    if(!ioctl(fileno(ttyout),TIOCGWINSZ,&sz))ans=sz.ws_col;
  1964.    else ans=0;
  1965.    stackint(ans);
  1966. }
  1967.  
  1968. void rxbitand(argc)
  1969. int argc;
  1970. {
  1971.    char *arg1,*arg2,*argt;
  1972.    int len1,len2,lent;
  1973.    char pad=255;
  1974.    if(argc==3){
  1975.       argt=delete(&lent);
  1976.       if(lent!=1)die(Ecall);
  1977.       pad=argt[0];
  1978.       argc--;
  1979.    }
  1980.    if(argc==2){
  1981.       arg2=delete(&len2);
  1982.       if(len2==-1)len2=0;
  1983.    }
  1984.    else{
  1985.       if(argc!=1)die(Ecall);
  1986.       len2=0;
  1987.    }
  1988.    arg1=delete(&len1);
  1989.    if(len1<0)die(Ecall);
  1990.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  1991.    argt=cstackptr+ecstackptr;
  1992.    for(lent=0;lent<len1;lent++)
  1993.       argt[lent]=arg1[lent]&(lent<len2?arg2[lent]:pad);
  1994.    argt+=lent=align(len1);
  1995.    *(int *)argt=len1;
  1996.    ecstackptr+=lent+four;
  1997. }
  1998. void rxbitor(argc)
  1999. int argc;
  2000. {
  2001.    char *arg1,*arg2,*argt;
  2002.    int len1,len2,lent;
  2003.    char pad=0;
  2004.    if(argc==3){
  2005.       argt=delete(&lent);
  2006.       if(lent!=1)die(Ecall);
  2007.       pad=argt[0];
  2008.       argc--;
  2009.    }
  2010.    if(argc==2){
  2011.       arg2=delete(&len2);
  2012.       if(len2==-1)len2=0;
  2013.    }
  2014.    else{
  2015.       if(argc!=1)die(Ecall);
  2016.       len2=0;
  2017.    }
  2018.    arg1=delete(&len1);
  2019.    if(len1<0)die(Ecall);
  2020.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  2021.    argt=cstackptr+ecstackptr;
  2022.    for(lent=0;lent<len1;lent++)
  2023.       argt[lent]=arg1[lent]|(lent<len2?arg2[lent]:pad);
  2024.    argt+=lent=align(len1);
  2025.    *(int *)argt=len1;
  2026.    ecstackptr+=lent+four;
  2027. }
  2028. void rxbitxor(argc)
  2029. int argc;
  2030. {
  2031.    char *arg1,*arg2,*argt;
  2032.    int len1,len2,lent;
  2033.    char pad=0;
  2034.    if(argc==3){
  2035.       argt=delete(&lent);
  2036.       if(lent!=1)die(Ecall);
  2037.       pad=argt[0];
  2038.       argc--;
  2039.    }
  2040.    if(argc==2){
  2041.       arg2=delete(&len2);
  2042.       if(len2==-1)len2=0;
  2043.    }
  2044.    else{
  2045.       if(argc!=1)die(Ecall);
  2046.       len2=0;
  2047.    }
  2048.    arg1=delete(&len1);
  2049.    if(len1<0)die(Ecall);
  2050.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  2051.    argt=cstackptr+ecstackptr;
  2052.    for(lent=0;lent<len1;lent++)
  2053.       argt[lent]=arg1[lent]^(lent<len2?arg2[lent]:pad);
  2054.    argt+=lent=align(len1);
  2055.    *(int *)argt=len1;
  2056.    ecstackptr+=lent+four;
  2057. }
  2058.  
  2059. void rxuserid(argc)
  2060. int argc;
  2061. {
  2062.    void endpwent();
  2063.    static int uid=-1;
  2064.    int cuid;
  2065.    static struct passwd *pw=0;
  2066.    if(argc)die(Ecall);
  2067.    if((cuid=getuid())!=uid)
  2068.       uid=cuid,
  2069.       pw=getpwuid(cuid),
  2070.       endpwent();
  2071.    if(!pw)stack(cnull,0);
  2072.    else stack(pw->pw_name,strlen(pw->pw_name));
  2073. }
  2074.  
  2075. void rxgetcwd(argc)
  2076. int argc;
  2077. {
  2078.    char *getwd();
  2079.    static char name[MAXPATHLEN];
  2080.    if(argc)die(Ecall);
  2081.    getwd(name);
  2082.    stack(name,strlen(name));
  2083. }
  2084.  
  2085. void rxchdir(argc)
  2086. int argc;
  2087. {
  2088.    char *arg;
  2089.    int len;
  2090.    if(argc!=1)die(Ecall);
  2091.    arg=delete(&len);
  2092.    arg[len]=0; /* that location must exist since the length used to be
  2093.                   after the string */
  2094.    if(chdir(arg))stackint(errno);
  2095.    else stack("0",1);
  2096. }
  2097.  
  2098. void rxgetenv(argc)
  2099. int argc;
  2100. {
  2101.    char *arg;
  2102.    int len;
  2103.    if(argc!=1)die(Ecall);
  2104.    arg=delete(&len);
  2105.    arg[len]=0;
  2106.    if(arg=getenv(arg))stack(arg,strlen(arg));
  2107.    else stack(cnull,0);
  2108. }
  2109.  
  2110. void rxputenv(argc)
  2111. int argc;
  2112. {
  2113.    char *arg;
  2114.    char *eptr;
  2115.    int len;
  2116.    int exist;
  2117.    char **value;
  2118.    int path;
  2119.    if(argc!=1)die(Ecall);
  2120.    arg=delete(&len);
  2121.    arg[len++]=0;
  2122.    if(!(eptr=strchr(arg,'=')))die(Ecall);
  2123.    eptr[0]=0;
  2124.    value=(char**)hashfind(0,arg,&exist);
  2125.    path=strcmp(arg,"PATH");
  2126.    eptr[0]='=';
  2127.    putenv(arg); /* release the previous copy from the environment */
  2128.    if(!exist)*value=allocm(len);
  2129.    else if(strlen(*value)<len)
  2130.       if(!(*value=realloc(*value,len)))die(Emem);
  2131.    strcpy(*value,arg);
  2132.    if(putenv(*value))stack("1",1);
  2133.    else stack("0",1);
  2134.    if(!path)hashclear(); /* clear shell's hash table on change of PATH */
  2135. }
  2136.  
  2137. void rxopen2(stream,mode,mlen,path,plen)
  2138. char *stream,*mode,*path;   /* implement open(stream,mode,path) */
  2139. int mlen,plen;
  2140. {
  2141.    char modeletter[3];
  2142.    struct fileinfo *info;
  2143.    FILE *fp;
  2144.    int rc;
  2145.    modeletter[0]='r';
  2146.    modeletter[1]=modeletter[2]=0;
  2147.    if(plen<=0)path=stream,plen=strlen(stream);
  2148.    if(memchr(path,0,plen))die(Ecall);
  2149.    path[plen]=0;
  2150.    if(mlen>0)switch(mode[0]&0xdf){
  2151.       case 'R': break;
  2152.       case 'W': modeletter[0]='w';
  2153.                 modeletter[1]='+';
  2154.                 break;
  2155.       case 'A': rc=access(path,F_OK);
  2156.                 modeletter[0]=rc?'w':'r';
  2157.                 modeletter[1]='+';
  2158.                 break;
  2159.       default:  die(Ecall);
  2160.    }
  2161.    if(info=(struct fileinfo *)hashget(1,stream,&rc)){
  2162.       fp=info->fp;          /* if "stream" already exists, perform freopen */
  2163.       free((char *)info);
  2164.       *(struct fileinfo **)hashfind(1,stream,&rc)=0;
  2165.       fp=freopen(path,modeletter,info->fp);
  2166.    }
  2167.    else fp=fopen(path,modeletter);
  2168.    if(!fp){
  2169.       stackint(errno);
  2170.       return;
  2171.    }
  2172.    if(modeletter[0]=='r'&&modeletter[1]=='+') /* for append, go to eof */
  2173.       fseek(fp,0L,2);
  2174.    info=fileinit(stream,path,fp);
  2175.    info->wr=modeletter[1]=='+';
  2176.    stack("0",1);
  2177. }
  2178.  
  2179. void rxopen(argc)
  2180. int argc;
  2181. {
  2182.    char *stream,*mode,*path;
  2183.    int len=0,mlen=0,plen;
  2184.    if(argc==3){
  2185.       argc--;
  2186.       stream=delete(&len);
  2187.       if(len<0)stream=0;
  2188.       else
  2189.          if(memchr(stream,0,len))die(Ecall);
  2190.          else stream[len]=0;
  2191.       if(!len)die(Ecall);
  2192.    }
  2193.    if(argc==2){
  2194.       argc--;
  2195.       mode=delete(&mlen);
  2196.    }
  2197.    if(argc!=1)die(Ecall);
  2198.    path=delete(&plen);
  2199.    if(plen<=0)die(Ecall);
  2200.    path[plen]=0;
  2201.    if(len<=0)stream=path,len=plen;
  2202.    rxopen2(stream,mode,mlen,path,plen);
  2203. }
  2204.  
  2205. void rxfdopen2(stream,mode,modelen,n,nlen) /* implement fdopen(stream,mode,n)*/
  2206. char *stream;
  2207. char *n;
  2208. int nlen;
  2209. char *mode;
  2210. int modelen;
  2211. {
  2212.    int fd;
  2213.    char fmode[3];
  2214.    FILE *fp;
  2215.    int streamlen=strlen(stream);
  2216.    fmode[0]='r';
  2217.    fmode[1]=fmode[2]=0;
  2218.    if(nlen<=0)n=stream,nlen=streamlen; /* default number is same as name */
  2219.    mtest(workptr,worklen,nlen+streamlen+2,nlen+streamlen+2-worklen);
  2220.    memcpy(workptr,n,nlen);
  2221.    workptr[nlen]=0;
  2222.    memcpy(workptr+nlen+1,stream,streamlen+1);
  2223.    eworkptr=nlen+streamlen+2;
  2224.    stack(workptr,nlen);
  2225.    fd=getint(1);       /* convert the fd to an integer */
  2226.    if(modelen>0)switch(mode[0]&0xdf){
  2227.       case 'R': break;
  2228.       case 'W': fmode[0]='w';
  2229.                 fmode[1]='+';
  2230.                 break;
  2231.       case 'A': fmode[0]='r';
  2232.                 fmode[1]='+';
  2233.                 break;
  2234.       default:  die(Ecall);
  2235.    }
  2236.    if(fp=fdopen(fd,fmode)){
  2237.       fileinit(workptr+nlen+1,cnull,fp)->wr=fmode[1]=='+';
  2238.       errno=0;
  2239.    }
  2240.    stackint(errno);
  2241. }
  2242.  
  2243. void rxfdopen(argc)
  2244. int argc;
  2245. {
  2246.    char *stream,*n,*mode;
  2247.    int len=0,nlen=0,modelen=0;
  2248.    if(argc==3){
  2249.       argc--;
  2250.       stream=delete(&len);
  2251.       if(len>0)
  2252.          if(memchr(stream,0,len))die(Ecall);
  2253.          else stream[len]=0;
  2254.       if(len==0)die(Ecall);
  2255.       stream[len]=0;
  2256.    }
  2257.    if(argc==2){
  2258.       argc--;
  2259.       mode=delete(&modelen);
  2260.       if(modelen==0)die(Ecall);
  2261.    }
  2262.    if(argc!=1)die(Ecall);
  2263.    n=delete(&nlen);
  2264.    n[nlen]=0;
  2265.    if(nlen<=0)die(Ecall);
  2266.    if(len<=0)stream=n,len=nlen;
  2267.    rxfdopen2(stream,mode,modelen,n,nlen);
  2268. }
  2269.  
  2270. void rxpopen2(stream,mode,mlen,command,comlen)
  2271. char *stream,*mode,*command;      /* implement popen(stream,mode,command) */
  2272. int mlen,comlen;
  2273. {
  2274.    char fmode[2];
  2275.    int rc;
  2276.    FILE *fp;
  2277.    struct fileinfo *info;
  2278.    fmode[0]='r';
  2279.    fmode[1]=0;
  2280.    if(mlen>0)fmode[0]=mode[0]|0x20;
  2281.    if(fmode[0]!='r'&&fmode[0]!='w')die(Ecall);
  2282.    if(comlen<=0)command=stream,comlen=strlen(stream);
  2283.    else command[comlen]=0;
  2284.    if(memchr(command,0,comlen))die(Ecall);
  2285.    if(fp=popen(command,fmode)){
  2286.       info=fileinit(stream,cnull,fp);
  2287.       info->wr=fmode[0]=='w',
  2288.       info->lastwr=info->wr;
  2289.       rc=0;
  2290.    }
  2291.    else rc=errno;
  2292.    stackint(rc);
  2293. }
  2294.  
  2295. void rxpopen(argc)
  2296. int argc;
  2297. {
  2298.    char *stream,*mode,*command;
  2299.    int len=0,mlen=0,comlen;
  2300.    if(argc==3){
  2301.       argc--;
  2302.       stream=delete(&len);
  2303.       if(len<0)stream=0;
  2304.       else
  2305.          if(memchr(stream,0,len))die(Ecall);
  2306.          else stream[len]=0;
  2307.       if(!len)die(Ecall);
  2308.    }
  2309.    if(argc==2){
  2310.       argc--;
  2311.       mode=delete(&mlen);
  2312.    }
  2313.    if(argc!=1)die(Ecall);
  2314.    command=delete(&comlen);
  2315.    if(comlen<=0)die(Ecall);
  2316.    command[comlen]=0;
  2317.    if(len<=0)stream=command,len=comlen;
  2318.    rxpopen2(stream,mode,mlen,command,comlen);
  2319. }
  2320.  
  2321. void rxlinein(argc)
  2322. int argc;
  2323. {
  2324.    char *name=0;
  2325.    int lines=1;
  2326.    int pos= 0;
  2327.    int len;
  2328.    int call;
  2329.    int ch=0;
  2330.    long filepos;
  2331.    struct fileinfo *info;
  2332.    FILE *fp;
  2333.    if(argc==3){
  2334.       argc--;
  2335.       if(isnull())delete(&len);
  2336.       else if((lines=getint(1))!=0&&lines!=1)die(Ecall);
  2337.    }
  2338.    if(argc==2){
  2339.       argc--;
  2340.       if(isnull())delete(&len);
  2341.       else if((pos=getint(1))<1)die(Ecall);
  2342.    }
  2343.    if(argc==1){
  2344.       argc--;
  2345.       name=delete(&len);
  2346.       if(len<0)name=0;
  2347.       else
  2348.          if(memchr(name,0,len))die(Ecall);
  2349.          else name[len]=0;
  2350.       if(!len)die(Ecall);
  2351.    }
  2352.    if(argc)die(Ecall);
  2353.    if(!name)name="stdin";
  2354.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){/* If not found, then */
  2355.       fp=fopen(name,"r");                             /* open it for reading */
  2356.       info=fileinit(name,name,fp);
  2357.       if(!fp){
  2358.          info->errno=errno+Eerrno;
  2359.          rcset(errno,Enotready,name);
  2360.          stack(cnull,0);
  2361.          return;
  2362.       }
  2363.       info->lastwr=0;
  2364.    }
  2365.    else fp=info->fp;
  2366.    if(!fp){
  2367.       rcset(info->errno-Eerrno,Enotready,name);
  2368.       stack(cnull,0);
  2369.       return;
  2370.    }
  2371.    if(info->persist && info->lastwr==0 &&
  2372.          (filepos=ftell(info->fp))>=0 && filepos!=info->rdpos)
  2373.       info->rdpos=filepos,
  2374.       info->rdline=0; /* position has been disturbed by external prog */
  2375.    clearerr(fp);      /* Ignore errors and try from scratch */
  2376.    info->errno=0;
  2377.    if(info->lastwr || pos>0)len=fseek(fp,info->rdpos,0);
  2378.    else len=0;
  2379.    info->lastwr=0;
  2380.    if(pos>0 && (len<0 || !info->persist)){
  2381.       info->errno=Eseek;        /* Seek not allowed on transient stream */
  2382.       rcset(Eseek-Eerrno,Enotready,name);
  2383.       stack(cnull,0);
  2384.       return;
  2385.    }
  2386.    if(pos>0){                   /* Search for given line number (ugh!) */
  2387.       if(info->rdline==0 || info->rdline+info->rdchars>pos)
  2388.          fseek(fp,0L,0),
  2389.          info->rdline=1;
  2390.       info->rdchars=0;
  2391.       for(;ch!=EOF&&info->rdline<pos;info->rdline++)
  2392.          while((ch=getc(fp))!='\n'&&ch!=EOF);
  2393.       if(ch==EOF){
  2394.          info->rdline--;
  2395.          info->errno=Ebounds;
  2396.          rcset(Ebounds-Eerrno,Enotready,name);
  2397.          stack(cnull,0);
  2398.          return;
  2399.       }
  2400.    }
  2401.    len=0;
  2402.    if(lines){
  2403.       call=sgstack[interplev].callon&(1<<Ihalt) |
  2404.            sgstack[interplev].delay &(1<<Ihalt);
  2405.       if(!call)siginterrupt(2,1); /* Allow ^C during read */
  2406.       while((ch=getc(fp))!='\n'&&ch!=EOF){
  2407.          mtest(pull,pulllen,len+1,256);
  2408.          pull[len++]=ch;
  2409.       }
  2410.       siginterrupt(2,0);
  2411.       if(delayed[Ihalt] && !call)
  2412.          delayed[Ihalt]=0,
  2413.          fseek(fp,info->rdpos,0), /* reset to start of line, if possible */
  2414.          die(Ehalt);
  2415.       if(info->rdline)info->rdline++;
  2416.       info->rdchars=0;
  2417.    }
  2418.    if((info->rdpos=ftell(fp))<0)info->rdpos=0;
  2419.    if(ch==EOF&&!len)rxseterr(info,name);
  2420.    else if(setrcflag)rcset(0,Enotready,name);
  2421.    stack(pull,len);
  2422. }
  2423.       
  2424. void rxlineout(argc)
  2425. int argc;
  2426. {
  2427.    char *name=0;
  2428.    char *file;
  2429.    int pos= 0;
  2430.    int charlen=0;
  2431.    int len;
  2432.    int acc;
  2433.    int ch=0;
  2434.    char *chars=0;
  2435.    long filepos;
  2436.    struct fileinfo *info;
  2437.    FILE *fp;
  2438.    if(argc==3){
  2439.       argc--;
  2440.       if(isnull())delete(&len);
  2441.       else if((pos=getint(1))<1)die(Ecall);
  2442.    }
  2443.    if(argc==2){
  2444.       argc--;
  2445.       chars=delete(&charlen);
  2446.       if(charlen<0)chars=0;
  2447.       else if(memchr(chars,'\n',charlen))die(Ecall);
  2448.    }
  2449.    if(argc==1){
  2450.       argc--;
  2451.       name=delete(&len);
  2452.       if(len<0)name=0;
  2453.       else
  2454.          if(memchr(name,0,len))die(Ecall);
  2455.          else name[len]=0;
  2456.       if(!len)die(Ecall);
  2457.    }
  2458.    if(argc)die(Ecall);
  2459.    if(!name)name="stdout";
  2460.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  2461.       acc=access(name,F_OK);  /* If not found in table, then open for append */
  2462.       fp=fopen(name,acc?"w+":"r+");
  2463.       if(fp)fseek(fp,0L,2);
  2464.       info=fileinit(name,name,fp);
  2465.       if(!fp){
  2466.          info->errno=errno+Eerrno;
  2467.          rcset(errno,Enotready,name);
  2468.          stack(chars?"1":"0",1);
  2469.          return;
  2470.       }
  2471.       info->wr=1;
  2472.    }
  2473.    else fp=info->fp;
  2474.    if(!fp){
  2475.       rcset(info->errno-Eerrno,Enotready,name);
  2476.       stack(chars?"1":"0",1);
  2477.       return;
  2478.    }
  2479.    if(!info->wr){  /* If it is open for reading, try to reopen for writing */
  2480.       file=(char*)(info+1);
  2481.       if(!file[0]){ /* reopen not allowed, since file name not given */
  2482.          info->errno=Eaccess;
  2483.          rcset(Eaccess-Eerrno,Enotready,name);
  2484.          stack(chars?"1":"0",1);
  2485.          return;
  2486.       }
  2487.       if(!(fp=freopen(file,"r+",fp))){
  2488.          info->errno=errno+Eerrno;
  2489.          fp=fopen(file,"r");/* try to regain read access */
  2490.          info->fp=fp;
  2491.          if(fp)fseek(fp,info->rdpos,0);
  2492.          rcset(info->errno-Eerrno,Enotready,name);
  2493.          stack(chars?"1":"0",1);
  2494.          file[0]=0;         /* Prevent this whole thing from happening again */
  2495.          return;
  2496.       }
  2497.       info->wr=1;
  2498.       fseek(fp,0L,2);
  2499.       info->wrline=0;
  2500.       info->lastwr=1;
  2501.       if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2502.    }
  2503.    if(info->persist && info->lastwr &&
  2504.          (filepos=ftell(fp))>=0 && filepos!=info->wrpos)
  2505.       info->wrpos=filepos,
  2506.       info->wrline=0;  /* position has been disturbed by external prog */
  2507.    clearerr(fp);       /* Ignore errors and try from scratch */
  2508.    info->errno=0;
  2509.    if(info->lastwr==0 || pos>0)len=fseek(fp,info->wrpos,0);
  2510.    else len=0;
  2511.    info->lastwr=1;
  2512.    if(pos>0 && (len<0 || !info->persist)){
  2513.       info->errno=Eseek;        /* Seek not allowed on transient stream */
  2514.       rcset(Eseek-Eerrno,Enotready,name);
  2515.       stack(chars?"1":"0",1);
  2516.       return;
  2517.    }
  2518.    if(pos>0){                   /* Search for required line number (Ugh!) */
  2519.       if(info->wrline==0 || info->wrline+info->wrchars>pos)
  2520.          fseek(fp,0L,0),
  2521.          info->wrline=1;
  2522.       info->wrchars=0;
  2523.       for(;ch!=EOF&&info->wrline<pos;info->wrline++)
  2524.          while((ch=getc(fp))!='\n'&&ch!=EOF);
  2525.       fseek(fp,0L,1);          /* seek between read and write */
  2526.       if(ch==EOF){
  2527.          info->wrline--;
  2528.          info->errno=Ebounds;
  2529.          rcset(Ebounds-Eerrno,Enotready,name);
  2530.          stack(chars?"1":"0",1);
  2531.          return;
  2532.       }
  2533.    }
  2534.    if(!chars){
  2535.       if(!pos){
  2536.          fflush(fp); /* No data and no position given so flush and go to EOF */
  2537.          fseek(fp,0L,2);
  2538.          info->wrline=0;
  2539.       }
  2540.       if((info->wrpos=ftell(fp))<0)info->wrpos=0; /* just pos given */
  2541.       stack("0",1);
  2542.       return;
  2543.    }
  2544.    chars[charlen++]='\n';
  2545.    if(fwrite(chars,charlen,1,fp)){
  2546.       stack("0",1);
  2547.       if(info->wrline)info->wrline++;
  2548.       info->wrchars=0;
  2549.       if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2550.       if(setrcflag)rcset(0,Enotready,name);
  2551.    }else{
  2552.       stack("1",1);
  2553.       rxseterr(info,name);
  2554.       fseek(fp,info->wrpos,0);
  2555.    }
  2556. }
  2557.  
  2558. void rxcharin(argc)
  2559. int argc;
  2560. {
  2561.    char *name=0;
  2562.    int chars=1;
  2563.    int pos= 0;
  2564.    int len;
  2565.    int l;
  2566.    int call;
  2567.    long filepos;
  2568.    struct fileinfo *info;
  2569.    FILE *fp;
  2570.    if(argc==3){
  2571.       argc--;
  2572.       if(isnull())delete(&len);
  2573.       else if((chars=getint(1))<0)die(Ecall);
  2574.    }
  2575.    if(argc==2){
  2576.       argc--;
  2577.       if(isnull())delete(&len);
  2578.       else if((pos=getint(1))<1)die(Ecall);
  2579.    }
  2580.    if(argc==1){
  2581.       argc--;
  2582.       name=delete(&len);
  2583.       if(len<0)name=0;
  2584.       else
  2585.          if(memchr(name,0,len))die(Ecall);
  2586.          else name[len]=0;
  2587.       if(!len)die(Ecall);
  2588.    }
  2589.    if(argc)die(Ecall);
  2590.    if(!name)name="stdin";
  2591.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  2592.       fp=fopen(name,"r"); /* not found in table so try to open */
  2593.       info=fileinit(name,name,fp);
  2594.       if(!fp){
  2595.          info->errno=errno+Eerrno;
  2596.          rcset(errno,Enotready,name);
  2597.          stack(cnull,0);
  2598.          return;
  2599.       }
  2600.       info->lastwr=0;
  2601.    }
  2602.    else fp=info->fp;
  2603.    if(!fp){
  2604.       rcset(info->errno-Eerrno,Enotready,name);
  2605.       stack(cnull,0);
  2606.       return;
  2607.    }
  2608.    if(info->persist && info->lastwr==0 &&
  2609.          (filepos=ftell(info->fp))>=0 && filepos!=info->rdpos)
  2610.       info->rdpos=filepos,
  2611.       info->rdline=0; /* position has been disturbed by external prog */
  2612.    clearerr(fp);
  2613.    info->errno=0;
  2614.    if(pos>0 && (!info->persist || fseek(fp,0L,2)<0)){
  2615.       info->errno=Eseek;        /* Seek not allowed on transient stream */
  2616.       rcset(Eseek-Eerrno,Enotready,name);
  2617.       stack(cnull,0);
  2618.       return;
  2619.    }
  2620.    if(pos){
  2621.       filepos=ftell(fp);      
  2622.       if(fseek(fp,(long)pos-1,0)>=0)info->rdpos=pos-1;
  2623.       info->rdline=0;
  2624.       if(filepos<pos){          /* Seek was out of bounds */
  2625.          info->errno=Ebounds;
  2626.          rcset(Ebounds-Eerrno,Enotready,name);
  2627.          stack(cnull,0);
  2628.          return;
  2629.       }
  2630.    }
  2631.    else if(info->lastwr)fseek(fp,info->rdpos,0);
  2632.    info->lastwr=0;
  2633.    call=sgstack[interplev].callon&(1<<Ihalt) |
  2634.         sgstack[interplev].delay &(1<<Ihalt);
  2635.    if(!call)siginterrupt(2,1); /* allow ^C to interrupt */
  2636.    mtest(workptr,worklen,chars,chars-worklen);
  2637.    len=fread(workptr,1,chars,fp);
  2638.    siginterrupt(2,0);
  2639.    if(delayed[Ihalt] && !call)
  2640.       delayed[Ihalt]=0,
  2641.       fseek(fp,info->rdpos,0),
  2642.       die(Ehalt);
  2643.    if(len&&info->rdline){ /* Try to keepo the line counter up to date */
  2644.       for(l=0;l<len;)if(workptr[l++]=='\n')info->rdline++;
  2645.       if(workptr[len-1]!='\n')info->rdchars=1;
  2646.    }
  2647.    if((info->rdpos=ftell(fp))<0)info->rdpos=0;
  2648.    if(len<chars)rxseterr(info,name);
  2649.    else if(setrcflag)rcset(0,Enotready,name);
  2650.    stack(workptr,len);
  2651. }
  2652.  
  2653. void rxcharout(argc)
  2654. int argc;
  2655. {
  2656.    char *name=0;
  2657.    char *file;
  2658.    int pos= 0;
  2659.    int charlen;
  2660.    int len;
  2661.    int acc;
  2662.    int l;
  2663.    char *chars=0;
  2664.    long filepos;
  2665.    struct fileinfo *info;
  2666.    FILE *fp;
  2667.    if(argc==3){
  2668.       argc--;
  2669.       if(isnull())delete(&len);
  2670.       else if((pos=getint(1))<1)die(Ecall);
  2671.    }
  2672.    if(argc==2){
  2673.       argc--;
  2674.       chars=delete(&charlen);
  2675.       if(charlen<0)chars=0,charlen=0;
  2676.    }
  2677.    else charlen=0;
  2678.    if(argc==1){
  2679.       argc--;
  2680.       name=delete(&len);
  2681.       if(len<0)name=0;
  2682.       else
  2683.          if(memchr(name,0,len))die(Ecall);
  2684.          else name[len]=0;
  2685.       if(!len)die(Ecall);
  2686.    }
  2687.    if(argc)die(Ecall);
  2688.    if(!name)name="stdout";
  2689.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  2690.       acc=access(name,F_OK); /* If not found in table, open for append */
  2691.       fp=fopen(name,acc?"w+":"r+");
  2692.       if(fp)fseek(fp,0L,2);
  2693.       info=fileinit(name,name,fp);
  2694.       if(!fp){
  2695.          info->errno=errno+Eerrno;
  2696.          rcset(errno,Enotready,name);
  2697.          stackint(charlen);
  2698.          return;
  2699.       }
  2700.       info->wr=1;
  2701.    }
  2702.    else fp=info->fp;
  2703.    if(!fp){
  2704.       rcset(info->errno-Eerrno,Enotready,name);
  2705.       stackint(charlen);
  2706.       return;
  2707.    }
  2708.    if(!info->wr){ /* If not open for write, try to gain write access */
  2709.       file=(char*)(info+1);
  2710.       if(!file[0]){
  2711.          info->errno=Eaccess;
  2712.          rcset(Eaccess-Eerrno,Enotready,name);
  2713.          stackint(charlen);
  2714.          return;
  2715.       }
  2716.       if(!(fp=freopen(file,"r+",fp))){
  2717.          info->errno=errno+Eerrno;
  2718.          fp=fopen(file,"r");/* try to regain read access */
  2719.          info->fp=fp;
  2720.          if(fp)fseek(fp,info->rdpos,0);
  2721.          rcset(info->errno-Eerrno,Enotready,name);
  2722.          stackint(charlen);
  2723.          file[0]=0;         /* Prevent this whole thing from happening again */
  2724.          return;
  2725.       }
  2726.       info->wr=1;
  2727.       fseek(fp,0L,2);
  2728.       info->wrline=0;
  2729.       info->lastwr=1;
  2730.       if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2731.    }
  2732.    if(info->persist && info->lastwr &&
  2733.          (filepos=ftell(fp))>=0 && filepos!=info->wrpos)
  2734.       info->wrpos=filepos,
  2735.       info->wrline=0;  /* position has been disturbed */
  2736.    clearerr(fp);
  2737.    info->errno=0;
  2738.    if(pos>0 && (!info->persist || fseek(fp,0L,2)<0)){
  2739.       info->errno=Eseek;        /* Seek not allowed on transient stream */
  2740.       rcset(Eseek-Eerrno,Enotready,name);
  2741.       stackint(charlen);
  2742.       return;
  2743.    }
  2744.    if(pos){
  2745.       filepos=ftell(fp);
  2746.       if(fseek(fp,(long)pos-1,0)>=0)info->wrpos=pos-1;
  2747.       info->wrline=0;
  2748.       if(filepos+1<pos){        /* Seek was out of bounds */
  2749.          info->errno=Ebounds;
  2750.          rcset(Ebounds-Eerrno,Enotready,name);
  2751.          stack(cnull,0);
  2752.          return;
  2753.       }
  2754.    }
  2755.    else if(info->lastwr==0)fseek(fp,info->wrpos,0);
  2756.    info->lastwr=1;
  2757.    if(!chars){
  2758.       if(!pos){
  2759.          fflush(fp); /* No data, no pos, so flush and seek to EOF */
  2760.          fseek(fp,0L,2);
  2761.          info->wrline=0;
  2762.       }
  2763.       if((info->wrpos=ftell(fp))<0)info->wrpos=0; /* no data, so OK */
  2764.       stack("0",1);
  2765.       return;
  2766.    }
  2767.    len=fwrite(chars,1,charlen,fp);
  2768.    info->wrpos+=len;
  2769.    if(len&&info->wrline){
  2770.       for(l=0;l<len;)if(chars[l++]=='\n')info->wrline++;
  2771.       if(chars[len-1]!='\n')info->wrchars=1;
  2772.    }
  2773.    if(len<charlen)rxseterr(info,name);
  2774.    else if(setrcflag)rcset(0,Enotready,name);
  2775.    if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2776.    stackint(charlen-len);
  2777. }
  2778.  
  2779. void rxchars(argc)
  2780. int argc;
  2781. {
  2782.    rxchars2(argc,0);
  2783. }
  2784. void rxlines(argc)
  2785. int argc;
  2786. {
  2787.    rxchars2(argc,1);
  2788. }
  2789.  
  2790. void rxchars2(argc,line) /* = rxchars(argc) if line==0, or rxlines(argc) o/w */
  2791. int argc,line;
  2792. {
  2793.    long chars;
  2794.    long(filepos);
  2795.    int lines;
  2796.    char *name=0;
  2797.    int len;
  2798.    struct fileinfo *info;
  2799.    struct stat buf;
  2800.    int ch,c2;
  2801.    FILE *fp;
  2802.    extern int errno;
  2803.       if(argc==1){
  2804.       name=delete(&len);
  2805.       if(len<0)name=0;
  2806.       else
  2807.          if(memchr(name,0,len))die(Ecall);
  2808.          else name[len]=0;
  2809.       if(!len)die(Ecall);
  2810.    }
  2811.    else if(argc)die(Ecall);
  2812.    if(!name)name="stdin";
  2813.    info=(struct fileinfo *)hashget(1,name,&len);
  2814.    if(info && !info->fp){
  2815.       rcset(info->errno-Eerrno,Enotready,name);
  2816.       stack("0",1);
  2817.       return;
  2818.    }
  2819.    if(info){
  2820.       if(info->lastwr)fseek(info->fp,info->rdpos,0);
  2821.       if(ioctl(fileno(info->fp),FIONREAD,&chars))chars=0;
  2822. #ifndef NO_CNT
  2823.       chars+=(info->fp)->_cnt;  /* add the number of buffered chars */
  2824. #endif
  2825.       if(line && info->persist && (filepos=ftell(info->fp))>=0){
  2826.          lines=0;
  2827.          c2='\n';
  2828.          while((ch=getc(info->fp))!=EOF){ /* count lines */
  2829.             if(ch=='\n')lines++;
  2830.             c2=ch;
  2831.          }
  2832.          if(c2!='\n')lines++;
  2833.          fseek(info->fp,filepos,0);
  2834.       }
  2835.       else lines=(chars>0);
  2836.    }
  2837.    else { /* Not open.  Try to open it (to see whether we have access) */
  2838.           /* Funny thing is, we only make a fileinfo structure for it if
  2839.              there is an error (to hold the error number). */
  2840.       chars=lines=0;
  2841.       if(!(fp=fopen(name,"r"))){
  2842.          info=fileinit(name,name,fp);
  2843.          info->errno=errno+Eerrno;
  2844.          rcset(errno,Enotready,name);
  2845.       }
  2846.       else if(fstat(fileno(fp),&buf)){
  2847.          info=fileinit(name,name,fp);
  2848.          info->errno=errno+Eerrno;
  2849.          rcset(errno,Enotready,name);
  2850.          /* file is still open, but that's OK since its info is stored */
  2851.       }
  2852.       else if(!S_ISREG(buf.st_mode)){
  2853.          /* Not a regular file.  Sometimes we are allowed to fopen a directory,
  2854.             in which case EISDIR should be reported.  Otherwise, since we
  2855.             were allowed to open the file, assume it is a readable file with
  2856.             no characters (e.g. a tty) and do not report an error. */
  2857.          if(S_ISDIR(buf.st_mode)){
  2858.             fclose(fp);
  2859.             info=fileinit(name,cnull,(FILE *)0);
  2860.             info->errno=EISDIR+Eerrno;
  2861.             rcset(EISDIR,Enotready,name);
  2862.          }
  2863.          else fclose(fp);
  2864.       }
  2865.       else{
  2866.          chars=buf.st_size;
  2867.          if(line){    /* Count lines */
  2868.             c2='\n';
  2869.             while((ch=getc(fp))!=EOF){
  2870.                if(ch=='\n')lines++;
  2871.                c2=ch;
  2872.             }
  2873.             if(c2!='\n')lines++;
  2874.          }
  2875.          else lines=(chars>0);
  2876.          fclose(fp);
  2877.       }
  2878.    }
  2879.    if(line)stackint(lines);
  2880.    else stackint((int)chars); /* Ahem! */
  2881. }
  2882.  
  2883. void rxclose(argc)
  2884. int argc;
  2885. {
  2886.    char *name;
  2887.    int len;
  2888.    if(argc!=1)die(Ecall);
  2889.    name=delete(&len);
  2890.    if(memchr(name,0,len))die(Ecall);
  2891.    else name[len]=0;
  2892.    if(!len)die(Ecall);
  2893.    stackint(fileclose(name));
  2894. }
  2895.  
  2896. void rxpclose(argc)
  2897. int argc;
  2898. {
  2899.    char *name;
  2900.    int len;
  2901.    int rc;
  2902.    char *ptr;
  2903.    struct fileinfo *info;
  2904.    if(argc!=1)die(Ecall);
  2905.    name=delete(&len);
  2906.    if(memchr(name,0,len))die(Ecall);
  2907.    else name[len]=0;
  2908.    if(!len)die(Ecall);
  2909.    ptr=hashsearch(1,name,&len);
  2910.    if(len&&(info=(struct fileinfo *)(((hashent *)ptr)->value))){
  2911.       if(info->fp)rc=pclose(info->fp);
  2912.       else rc=-1;
  2913.       if(info->fp && rc<0)fclose(info->fp); /* if error, close anyway */
  2914.       free((char*)info);
  2915.       ((hashent *)ptr)->value=0;
  2916.    }
  2917.    else rc=0;
  2918.    if(rc==-1)stack("-1",2);
  2919.    else stackint((char)(rc/256));
  2920. }
  2921.    
  2922. void rxfileno(argc)
  2923. int argc;
  2924. {
  2925.    char *name;
  2926.    int len;
  2927.    struct fileinfo *info;
  2928.    if(argc!=1)die(Ecall);
  2929.    name=delete(&len);
  2930.    if(memchr(name,0,len))die(Ecall);
  2931.    else name[len]=0;
  2932.    if(!len)die(Ecall);
  2933.    if(!(info=(struct fileinfo *)hashget(1,name,&len)) || !(info->fp))
  2934.       stack("-1",2);
  2935.    else stackint(fileno(info->fp));
  2936. }
  2937.  
  2938. void rxftell(argc)
  2939. int argc;
  2940. {
  2941.    char *name;
  2942.    int len;
  2943.    struct fileinfo *info;
  2944.    if(argc!=1)die(Ecall);
  2945.    name=delete(&len);
  2946.    if(memchr(name,0,len))die(Ecall);
  2947.    else name[len]=0;
  2948.    if(!len)die(Ecall);
  2949.    if(!(info=(struct fileinfo *)hashget(1,name,&len)) || !(info->fp))len=-1;
  2950.    else len=ftell(info->fp); /* Ahem! */
  2951.    if(len>=0)len++;
  2952.    stackint(len);
  2953. }
  2954.  
  2955. void rxstream(argc)
  2956. int argc;
  2957. {
  2958.    char *stream;
  2959.    char option='S';
  2960.    char *command=0;
  2961.    char *param;
  2962.    int comlen;
  2963.    int len;
  2964.    int exist;
  2965.    char *answer;
  2966.    struct fileinfo *info;
  2967.    if(argc==3){
  2968.       command=delete(&comlen);
  2969.       argc--;
  2970.       if(comlen<=0)die(Ecall);
  2971.    }
  2972.    if(argc==2){
  2973.       stream=delete(&len);
  2974.       argc--;
  2975.       if(len==0)die(Ecall);
  2976.       if(len>0)option=stream[0]&0xdf;
  2977.    }
  2978.    if(argc!=1)die(Ecall);
  2979.    stream=delete(&len);
  2980.    if(len<1)die(Ecall);
  2981.    if(memchr(stream,0,len))die(Ecall);
  2982.    stream[len]=0;
  2983.    info=(struct fileinfo *)hashget(1,stream,&exist);
  2984.    switch(option){
  2985.       case 'D': if(command)die(Ecall);
  2986.          if(!info)answer="Stream is not open";
  2987.          else if(!info->errno)answer="Ready";
  2988.          else answer=message(info->errno);
  2989.          stack(answer,strlen(answer));
  2990.          return;
  2991.       case 'S': if(command)die(Ecall);
  2992.          if(!info)stack("UNKNOWN",7);
  2993.          else if(!info->errno)stack("READY",5);
  2994.          else if(info->errno==Eeof+Eerrno || info->errno<Eerrno)
  2995.             stack("NOTREADY",8);
  2996.          else stack("ERROR",5);
  2997.          return;
  2998.       case 'C': break; /* out of the switch to do the work */
  2999.       default: die(Ecall);
  3000.    }
  3001.    if(!command)die(Ecall);
  3002.    param=command;
  3003.    while(comlen--&& *param++!=' ');    /* Find the command end */
  3004.    if(comlen>=0){
  3005.       param[-1]=0;                     /* terminate the command */
  3006.       while(comlen--&& *param++==' '); /* Find the parameter */
  3007.       comlen++,param--;
  3008.    }
  3009.    else param[0]=comlen=0;
  3010.    /***/if(!strcasecmp(command,"close")){ /* syntax: "close" */
  3011.       if(comlen)die(Ecall);
  3012.       stackint(fileclose(stream));
  3013.    }
  3014.    else if(!strcasecmp(command,"fdopen")){/* syntax: "fdopen [mode][,n]" */
  3015.       char *n;
  3016.       for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3017.       comlen-=len+1;
  3018.       for(n=param+len+1;comlen>0&&n[0]==' ';n++,comlen--);
  3019.       if(comlen<0)comlen=0;
  3020.       rxfdopen2(stream,param,len,n,comlen);
  3021.    }
  3022.    else if(!strcasecmp(command,"fileno")){/* syntax: "fileno" */
  3023.       if(info && info->fp)stackint(fileno(info->fp));
  3024.       else stack("-1",2);
  3025.    }
  3026.    else if(!strcasecmp(command,"flush")){ /* syntax: "flush" */
  3027.       if(info && info->fp)stackint(fflush(info->fp));
  3028.       else stack("-1",2);
  3029.    }
  3030.    else if(!strcasecmp(command,"ftell")){ /* syntax: "ftell" */
  3031.       if(info && info->fp)stackint(ftell(info->fp));
  3032.       else stack("-1",2);
  3033.    }
  3034.    else if(!strcasecmp(command,"open")){  /* syntax: "open [mode][,path]" */
  3035.       char *path;
  3036.       for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3037.       comlen-=len+1;
  3038.       for(path=param+len+1;comlen>0&&path[0]==' ';path++,comlen--);
  3039.       if(comlen<0)comlen=0;
  3040.       rxopen2(stream,param,len,path,comlen);
  3041.    }
  3042.    else if(!strcasecmp(command,"pclose")){/* syntax: "pclose" */
  3043.       char *ptr=hashsearch(1,stream,&exist);
  3044.       int rc;
  3045.       if(exist&&(info=(struct fileinfo *)(((hashent *)ptr)->value))){
  3046.          if(info->fp)rc=pclose(info->fp);
  3047.          else rc=-1;
  3048.          if(info->fp && rc<0)fclose(info->fp); /* if error, close anyway */
  3049.          free((char*)info);
  3050.          ((hashent *)ptr)->value=0;
  3051.       }
  3052.       else rc=0;
  3053.       if(rc==-1)stack("-1",2);
  3054.       else stackint((char)(rc/256));
  3055.    }
  3056.    else if(!strcasecmp(command,"popen")){ /* syntax: "popen [mode][,command]"*/
  3057.       char *cmd;
  3058.       for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3059.       comlen-=len+1;
  3060.       for(cmd=param+len+1;comlen>0&&cmd[0]==' ';cmd++,comlen--);
  3061.       if(comlen<0)comlen=0;
  3062.       rxpopen2(stream,param,len,cmd,comlen);
  3063.    }
  3064.    else die(Ecall);
  3065. }
  3066.  
  3067. void rxcondition(argc)
  3068. int argc;
  3069. {
  3070.    char option='I';
  3071.    char *arg;
  3072.    int len;
  3073.    int which=sgstack[interplev].which;
  3074.    if(argc>1)die(Ecall);
  3075.    if(argc){
  3076.       arg=delete(&len);
  3077.       if(len<=0)die(Ecall);
  3078.       option=arg[0]&0xdf;
  3079.    }
  3080.    switch(option){
  3081.       case 'I': arg=sgstack[interplev].type==1?"SIGNAL":"CALL";  break;
  3082.       case 'C': arg=conditions[which];                           break;
  3083.       case 'D': for(len=interplev;len>=0 && !(arg=sgstack[len].data);len--);
  3084.                                                                  break;
  3085.       case 'S': arg=sgstack[interplev].delay  &(1<<which)? "DELAY":
  3086.                     sgstack[interplev].callon &(1<<which)? "ON":
  3087.                     sgstack[interplev].bits   &(1<<which)? "ON":
  3088.                     "OFF";                                       break;
  3089.       default: die(Ecall);
  3090.    }
  3091.    if(!sgstack[interplev].type)arg=0;
  3092.    if(!arg)stack("",0);
  3093.    else stack(arg,strlen(arg));
  3094. }
  3095.                     
  3096.       
  3097.